26.08.12

 

       やりたいこと 

   →月や日の表示において1桁の場合には先頭に0をつけて入力したい

 

  操作方法

   →2段階必要

    ①まずセルの表示形式を文字列にする

    ②2桁入力

  

  コード例

   A列にシリアル値が入力されていて、

   B列に年、C列に月、D列に日 を表示したい

 

        Cells(irow, "B").NumberFormatLocal = "@"  '先に表示形式を設定 文字列へ
        Cells(irow, "B") = Format(Cells(irow, "A"), "ee")   '年2桁
        Cells(irow, "C").NumberFormatLocal = "@"    '先に表示形式を設定 文字列へ
        Cells(irow, "C") = Format(Cells(irow, "A"), "mm")    '月2桁
        Cells(irow, "D").NumberFormatLocal = "@"    '先に表示形式を設定 文字列へ
        Cells(irow, "D") = Format(Cells(irow, "A"), "dd")    '日2桁

 

 

 

26.06.06 小計機能
友人から質問をうけました。
データベースの途中に行を挿入してSUM関数使っているけど
いい方法ないんかな?
小計機能とおまけ.pdf
PDFファイル 89.0 KB

25.11.30

 

マクロの記録でオートフィルはできました。

行数は可変なので常に最終行まで対応できるコードは???

 

マクロの記録

  Selection.AutoFill Destination:=Range("D4:G546")
  Range("D4:G546").Select

解説:D列4行目からG列546行目までの範囲

 

 

改良:

ポイント:C列で最終行を取得(DからGは1行しか入っていないから)

 

    Dim Lrow As Long
    Lrow = Cells(Rows.Count, "C").End(xlUp).Row
    Selection.AutoFill Destination:=

  Range(Cells(4, "D"), Cells(Lrow, "G")) '("D4:G546")
    Range(Cells(4, "D"), Cells(Lrow, "G")).Select

25.7.25

 

 VBAで図を動かすことって、できますか??

 

 結論:もちろんできます(アニメーション風に動きを加えて・・・)

 

ヒント:

 動かしたい図の選択 → 現在地 を設定

 現在地から For ~ Next を 使い、Top Left を変化させます。

 

こんなことも:

 Timer関数で、処理時間も測ることができちゃいます。

 

 

25.5.8

 

ユーザーフォームでボタンでSelectした後に、マウスでセルをクリックしないと

入力ができない

 

そんなときは 「 AppActivate Application.Caption」

 

を使います

 

 セル.Select だけでは、選択はしていてもアクティブになっていない

 (ユーザーフォーム側があくちぶ)

 

 AppActivate Application.Caption 書くことで セルをセレクト→セルをあくちぶ

にしてくれる 

25.2.26

 

データベースファイルを開き、必要なデータだけを
ダミーシートにリストとして作成しそのリストを基に
ユーザーフォームを表示する

 

’ユーザーフォームを表示したいブックのシートモジュールへ

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'セルをダブルクリックしたときに
     Workbooks.Open Filename:="データベースのファイルパスから全部", ReadOnly:=True
    '読み取り専用で開き、                 ここがポイント↑
    Workbooks("ユーザーフォームを表示したいブックの").Worksheets("シート名").Activate
    'ユーザーフォームを表示したいブックのシート名アクチブにして
    UserForm1.Show
    'ユーザーフォームを表示
End Sub


’ユーザーフォームを表示したいブックのThisworkbook モジュール

’↓ここのの考え方がポイント
 ’ダミーシートを挿入
 ’リストと名前をつけ
 ’1行目にタイトル ここでは担当者・申告者

’Openイベント
Private Sub Workbook_Open()
    Worksheets.Add
    ActiveSheet.Name = "リスト"
'    申告者リストから担当者のみのリストを作成新規 シート名: リスト
    Range("A1").Value = "担当者"
    Range("B1").Value = "申告者"
    Worksheets("シート名").Activate
End Sub

'Closeイベント 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayAlerts = False
        Worksheets("リスト").Delete
    Application.DisplayAlerts = True ’削除メッセージ表示しない
'ダミーシートだからOpenイベントで開くときにその都度作成するから削除する
End Sub


Private Sub UserForm_Initialize()
    'リストボックスのイニシャライズイベント

    Dim irow As Long
    Dim Lrow As Long
    Dim Srow As Long
    Dim Rist As Worksheet ’ここ最後にsいらない
    Dim Srist As Worksheet ’ここ最後にsいらない
    Dim Lrow2 As Long
   
    Set Rist = Workbooks("データベースファイル名").Worksheets("シート名")

    Set Srist = Workbooks("ユーザーフォームを表示したいブック").Worksheets("シート名")
   
    Rist.Activate
    Lrow = Rist.Cells(Rows.Count, "B").End(xlUp).Row
    Srist.Activate
    Srow = Srist.Cells(Rows.Count, "A").End(xlUp).Row + 1

    For irow = 2 To Lrow
       If Rist.Cells(irow, "Q") = Workbooks("ユーザーフォームを表示したいブック").Worksheets("シート名").Range("P2") Then
           Srist.Cells(Srow, "A") = Rist.Cells(irow, "Q")
           Srist.Cells(Srow, "B") = Rist.Cells(irow, "B")
           Srow = Srow + 1
       End If
    Next irow
   
'リストボックスは表示するリストは
'特定のセルに担当者が入力されているところを利用
'シートへ貼り付け
'そのリストを利用

    Srist.Activate
    Lrow2 = Srist.Cells(Rows.Count, "A").End(xlUp).Row

    ListBox1.List = Srist.Range(Cells(2, 2), Cells(Lrow2, 2)).Value ’ここvalue忘れずに
   
    Worksheets("シート名").Activate
    'シートををアクチブに
End Sub

 

'ユーザーフォームのリストボックスのクリックイベント
Private Sub ListBox1_Click()
    Range("表示したいセル") = ListBox1.List(ListBox1.ListIndex)
    'リストを 表示したいセルへ代入
End Sub

'ユーザーフォーム閉じるイベント
Private Sub UserForm_Terminate()
'    Workbooks("データベースのファイルパスから全部").Close
End Sub

25.1.25

 

Q、 ユーザー定義関数を作ってみたいのですが・・・

 

A、 以下に例を示します subを使ってCallする方法もありますのでそれは後日

 

   Function 消費税(Money As Long) '消費税額を求める
       消費税 = Int(Money * 0.05)
   End Function

 


   Function 閏年(nen As Long) '閏年判定する
       If ((nen Mod 4) = 0 And (nen Mod 100) <> 0 Or (nen Mod 400) = 0) Then
            閏年 = nen & "年は閏年です"
       Else
            閏年 = nen & "年は閏年ではありません"
       End If
   End Function

24.09.10

 

 Q、標準モジュールを追加すると

 プロジェクトエクスプロラーに追加されますが、モジュールのフォルダが作成されません

 

 

 A、その上のフォルダマークをクリックするとシート名とフォルダ名でフォルダを分けて表示します

 

  なにかの勢いで押してしまったのでしょうね・・・

 

 

 

 

 

24.6.21

 

シート間で値貼付けをしようと、

 

Sub コピー2()
    Sheets("sheet1").Range(Cells(2, 2), Cells(2, 5)).Value = Sheets("sheet2").Range(Cells(1, 1), Cells(1, 4)).Value
End Sub

  

と書いたら、「アプリケーション定義またはオブジェクト定義のエラー」

 

ですよと優しく怒られました

 

原因は、「Cellsの前にシートの指定がないこと」・・・でした

 

分からず、いつものエクセルサロンで教えて頂きました いつもありがとうございます

 

おかげで回答いただくとすぐ納得できるようになりました

 

しかし、デバックの基本からやり直しですな・・・・

エクセル相談事例

24.6.1

  

  エクセル2010 で以前のように印刷プレビューしたい件

 

  方法はこちら  ↓

 

 

  

全画面表示
エクセル2010での印刷プレビュー
以前のように表示できるボタンです
稲田様 全画面プレビュー.pdf
PDFファイル 94.8 KB

24.4.24

 

 2010 F1でヘルプが表示されない件

 

  エクセルサロンで教えていただきました

 

  いつもありがとうございます

 

  ポイントは、F1押して、

 このページは利用できません。 

  の画面で右下を確認

 

  Office.comに接続 なっているところを、クリックして

  

  このコンピューター上のコンテンツのみを表示 へ変更

 

  オフライン という表記になる

 

  それで大丈夫!!

 

 

  

 

24.4.24 その2

 

イメージ 変数 範囲 コードイメージ サンプルコード の順番で組み立てるとあとで見やすいかも

24.4.24

 

 Q、入力用と集計用のシートがあり、入力用のデータ入力が済んだら、集計用に転記したい

 

 A,下記の手順で構築していく

 

 (イメージ)

   入力用・・・月ごと   集計用・・・年のデータ

   入力用のデータ、項目行除いたデータを集計用に貼付け(値貼付けがGOOD)

   集計用の最終行にどんどん追加していく

 

 (変数)

   入力用の最終行 と 集計行の最終行 と 行を降りるカウンタ

 

 (範囲)

   入力用には余分な行もある。しかも、テーブルを使っているため、

   CurrentRegionプロパティ は余計な部分まで含まれてしまうから

   1行ずつ見ていくことにする

  

 (コードイメージ)

 

   入力用のB列を見ていき空白ではなかったら、その行全体を選択 Resizeプロパティで

   必要なところまで

 

   それを値貼付け ここでの登場は、 PasteSpecial ではなく

 

   = です  くれぐれも 右辺と左辺を間違わないように

 

   Copy は コピー元が 左だけどね

 

 

 

   

乙の手取額からの逆算
所得税額乙欄の方の給与額 手取りを設定して
支給額と税額を算出します
乙の手取額からの逆算.xlsm.zip
zip ( 圧縮 ) ファイル 55.8 KB

24.2.22

 

’ブックの保護をマクロで実行

 

一部のコードは エクセルサロンで教えていただきました

いつもありがとうございます

 

Sub 非表示()
    '保護がかかっていたら非表示できないので
    '保護解除
    ActiveWorkbook.Unprotect Password:="111"
    ActiveSheet.Visible = False 'falseで非表示
MsgBox "非表示にしたよ"
    '保護
    ActiveWorkbook.Protect Password:="111"
    Sheets("sheet2").Range("B2").Select
End Sub

 

Sub 再表示()
    Dim 処理 As Long
    Dim flg As Boolean ’ここを教えていただいた
   
    処理 = MsgBox("本当に実行しますか?", vbYesNo)
    If 処理 = vbYes Then
    On Error GoTo myError   ’ここは自力 エラー判定
        flg = Application.Dialogs(xlDialogWorkbookProtect).Show 'パスワード要求画面
        If flg = False Then    ’ここを教えていただいた

            MsgBox "キャンセルされました"
            Exit Sub
        End If
        Sheets("sheet1").Visible = True 'trueで表示
    Else
        Exit Sub
    End If
    MsgBox "禁断のシートを開きました"
    Sheets("sheet1").Select
    Range("B2").Select
         Exit Sub
myError:   ’エラーの時の処理
        MsgBox "パスワードが違います"
End Sub

 

 

24.2.17

 

 Msgbox の使い方  vbOKCancel OKボタンとキャンセル を表示してくれる

 

 これはいろいろ応用が利きそう

 

 

24.2.16 マクロの呼び出し方

 

 標準モジュールにかいていたマクロを効率よく?呼び出す方法

 

   ユーザーフォームを作成し、ボタン配置 クリックイベントで、Callで呼んできて

   そのユーザーフォームを呼び出すのは、Show でクイックアクセスツールバーに登録

 

24.2.15

 

 セルをダブルクリックしたときに・・・

 

 ワークシートもモジュールへ

 

 プルダウンから選んだら最初と最後はでてきます

 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveCell.Resize(1, 12).Select   ’1行12列を選択
End Sub

 

 

 

24.2.15

 

Sub 削除()
    Range("a6").EntireRow.Delete   ’行全体削除 Entirerow
End Sub
Sub 表示()
    MsgBox Range("C3").Value
    MsgBox Range("C3").Value2    ’シリアル値  Value2
End Sub

  

 

24.2.14

 

 グラフを挿入するときに、X軸に特定の列を使いたい

 

 その列が、文字列ならいいけど、数値データならデータとしてグラフ中に入ってしまいます

 

 軸を選択して、右クリック 編集で設定しなおすとできます

 

 

 

 

24.2.9

 

  ブックを開いたときに常に特定のシートが表示されるようにしたい

 

   ThisWorkook を右クリック コードの表示で

 

Private Sub Workbook_Open()
        worksheets("ここにシート名"). Activate
End Sub

 

 と書きます

 

 

 

 

    

 

 

 24.2.2

 はいこれ便利

 

 値貼り付けは、記録マクロでやらなくても

 選択セル.value= 選択セル.value

 

 

 

 

 23.11.18

 

  テーブル(ピポットテーブルではありません)の構造化参照で・・・・

 

  テーブル外にテーブル内の範囲を参照して関数を組み立てた後

 

  それをコピーすると・・・・

 

 

  なんと、絶対参照のままです・・・(これは仕様らしい)

 

 

  エクセルサロンで教えて頂きました いつもありがとうございます

 

 

 

 

 

 

 

 

 23.11.15

 

  選択範囲の諸口

 

  Function 選択範囲の諸口の差額は(ByVal 左の列 As Range, ByVal 右の列 As Range, ByVal 合計範囲 As Range)
    選択範囲の諸口の差額は = WorksheetFunction.SumIf(左の列, 0, 合計範囲) - WorksheetFunction.SumIf(右の列, 0, 合計範囲)
End Function

 

 23.11.11

  特定のセルの値が変わったら、別のセルの値も変更したい

 

 例1 D6に1~12の値を入力それによってF6の値を変える

 

 ポイントはシートモジュールへ書くことです(標準モじゃないです) 


Private Sub Worksheet_Change(ByVal Target As Range)  'セルの値が変わったらの意
If Target.Address <> "$D$6" Then Exit Sub          'D6の値が変わったら
    Select Case Range("D6")
    Case 1, 3, 5, 7, 8, 10, 12
        Range("F6") = 31
    Case 4, 6, 9, 11
        Range("F6") = 30
    Case 2
        Range("F6") = 28
    Case Else
    MsgBox "12以下の数字(整数)を入力してください"
    End Select
End Sub

 

 

 

 

 

0の行を削除したい

 

 '10列目を下から見ていく

 ’セルの値が0ならその行全体を削除

 

  Sub 行削除()
    Dim i As Long
    For i = 216 To 2 Step -1
        If Cells(i, 10) = 0 Then
            Cells(i, 10).EntireRow.Delete
        End If
    Next i
End Sub

 

 

 

空白行を詰めて別のセルへ書き出したい (23.8.23)

 

 Sub test()
    Dim i As Long
    Dim 最終行 As Long
    For i = 1 To 7    
        If Cells(i, 1) <> "" Then   ’この例では1列目にデータが入力されています
            最終行 = Cells(Rows.Count, 3).End(xlUp).Row  ’3列目のの最終行を取得します

                           ’ここにもってくるのがポイント
            Cells(最終行 + 1, 3) = Cells(i, 1)      ’最終行+1に書き込んでいきます
        End If
    Next i
End Sub

 

 

 

 

 

 

 

 

 

 

 ☆テキストボックスに3桁表示した後、そのデータとセルの値を比べたい (23.7.13)

 

  

Private Sub UserForm_Initialize()
    Dim i As Long
    For i = 15 To 61
        ListBox1.AddItem Format(Cells(i, 3), "#,##0")
'        ListBox1.AddItem Cells(i, 3)
    Next i
End Sub

Private Sub CommandButton1_Click()
    Dim i As Long
    i = 15
    Do Until Format(Cells(i, 3).Value, "#,##0") = ListBox1.Text

 

 ’ここがポイント 両方とも3桁区切りさせる必要あり


'    Do Until Cells(i, 3).Value = Val(ListBox1.Text)
    i = i + 1
    Loop
        TextBox1 = Cells(i, 10)
End Sub

 

 

エクセルサロンで教えていただきました ありがとうございました

 

 23.12.27

 

 給与の源泉所得税 甲欄 ユーザー定義関数

 

 標準モジュールへ

 

 

=========================================== 

Function 給与所得税(扶養人数 As Long, 社会保険料控除後 As Long) As Variant

    Dim i As Long

    i = 13  '表の13行目からスタート
   
    Select Case 社会保険料控除後
   
        Case Is < 88000 '88,000未満は0
            給与所得税 = 0
       
        Case 88000 To 1003999
            With Sheets("月額表(平成23年1月以降分)") 'シート名の特定
                Do While 社会保険料控除後 >= .Cells(i, 2)    '社会保険料控除後の金額が表の値以上なら
                 i = i + 1                                '次の行を見る
                Loop
                給与所得税 = .Cells(i, 2).Offset(-1, 扶養人数 + 2)    '1行手前の扶養の人数+2行ずらした値
            End With
        Case Is >= 1004000 '1,040,001円以上 別計算が必要
            給与所得税 = "別計算"
       
        Case Else

    End Select
End Function

 

==================================================

23.12.15

 

 なんだか 開発備忘録みたくなってきた・・・

 

 ちゃんとまとめておこう

 

 さて、ファイルを特定するとき、フルパスを書く必要があるのは周知の事実

 

 自分のPCだけで使うときは良いが、他のPCで使うときはパスが変わってしまう・・・

 

 そこで、パスを変数にして、 変数+ファイル名 として扱うことを教えた頂いた

 

 毎度お世話になります エクセルサロン様 いつもありがとうございます

 

  ●集計先のファイルと集計元のファイルが同じフォルダに入っている場合の処理

 

  Dim パス As String    '各部門集計用ファイルのパスを取得し変数へ
        パス = ThisWorkbook.Path
      Workbooks.Open Filename:=パス & "\部門1.xlsx" 

 

  これで、どのパソコンでも部門1が開くのだ これスゴい!!!

 

Sub test()
    Dim X As Long
    X = 1
   
    Do Until X > 100
    X = X + 1          
        Debug.Print X     '最初は2が記録される  X=100になった時まず判定 101を記録される
    Loop
End Sub

 

Sub test2()
    Dim X As Long
    X = 1
   
    Do
    Debug.Print X   '最初は1が記録される X=100になったとき 判定されループを抜ける(101だから)
        X = X + 1
    Loop Until X > 100
End Sub

 

 

 

 

★VBAでユーザーフォームの表示位置を変更したい (23.7.12)

 

      With ユーザーフォーム名

       .StartUpPosition = 0  'Initializeで使う場合これがいる?(23.7.28)
           .Show
           .Top = ユーザーフォーム名.Top - 20   ’(+で下にずれる)
           .Left = ユーザーフォーム名.Left + 300  ’ (-で右にずれる)
      End With

 

 

 

 

 

 

 

 

 

 

★VBAコマンドボタン内で改行したい (23.7.12)

 

 

  なんとこれは、 SHIFT+ENTER で実現できます

 

 

 

 

 

 

 

 

 

 

 

  

 VBA テキストボックスへ 15.0 と初期値を設定したい

 

   間違ったコード  税率表示1.Value = 15.0   これでは15と表示されてしまう

 

   正しいコード     税率表示1.Value = "15.0"

 

            税率表示1.Value = Format(15, "#.0")  'これでも良い

            税率表示1.Value = Format(15, "0.0") 'これでも良い

 

   エクセルサロン のサイトで教えていただきました いつもありがとうございます

 

 

 

 

 

毎月ごとの給与の集計表から個人別の台帳を作成したい(23.6.8)

 

 マクロで実行

 

 シート構成の条件

  【その1】 i 月分の各シート行の項目は全て統一

  【その2】 列はいくら増やしても減っても構いません

 

        行列が一緒なら「串刺し」でできるし・・・・

        一緒でなくても「統合」でできるし・・・・

 

        ここはあえてマクロで実行

        「統合」は検算に使えますね

 

(サンプルマクロ)

 

Sub 集計()
   Dim 氏名検索 As Range
   Dim i As Long
   Dim 対象者 As String
  
   対象者 = Range("C2") 

   '年末調整用シートのセルC2に対象となる人をリストボックスから選択
   For i = 1 To 4        'とりあえず4月まで
   Set 氏名検索 = Sheets(i & "月分").Range("2:2").Find(what:=対象者)  

      '1月から順に2行目を見ていく
        If 氏名検索 Is Nothing Then
            MsgBox i & "月にその人はいません"        '対象者がいなかったら
        Else
            Cells(i + 5, 4) = 氏名検索.Offset(3, 0)   '対象者がいたらそのセルの3行下
            Cells(i + 5, 5) = 氏名検索.Offset(7, 0)   '対象者がいたらそのセルの7行下
            Cells(i + 5, 6) = 氏名検索.Offset(8, 0)   '対象者がいたらそのセルの8行下
            Cells(i + 5, 7) = 氏名検索.Offset(2, 0)   '対象者がいたらそのセルの2行下
        End If
    Next i
End Sub

        

What's New

ここには全ページに

共通の項目が表示されます。

 

<利用例>

What's New!

 

<利用例>

お問合わせはこちらから