Excel VBA ノート(サンプルコード)

Hide Tamura の Excel VBA ノート


利益計画シミュレーション、売れてます! 経営者様、会計事務所様、ご利用ください。

Excel-VBA オートフィルターによる非表示セルには、Findメソッドによる検索は通用しない。WorksheetFunction.CountIf

これまでは、条件に当てはまるセルがあるかどうかを検索する為に、Findメソッドを利用していました。

例えば、ある表の列にデータナンバーが入っていて、その列に検索したいデータナンバーがあるかどうかを調べる時など。

ところが、その表にオートフィルターを使用してしまうと、非表示になったセルに含まれるデータナンバーは、Findメソッドでは検索されないという問題が発生しました。

使用しているデータナンバーの最大値を調べる為、ワークシート関数も使用していましたが、こちらは非表示セルがあっても問題なく正しい結果が表示されています。ワークシート関数なら大丈夫なようです。


今回は、あるデータナンバーを検索し、そのセル番地を知りたいのではなく、既に使用しているかデータナンバーかどうかを調べたかったので、Findメソッドの使用は中止し、ワークシート関数の COUNTIFを使ってみました。

COUNTIF関数は、条件を満たすセルの個数を求める時に使用できます。つまり、検索したいデータナンバーが0にならなければ、既に使用しているナンバーという判断が可能になります。

WorksheetFunction.CountIf(Range("C:C"), lngNumb) = 0

となれば、使用されていないデータナンバーであることが判定できます。(lngNumbは、検索したい数値が入っている変数です)


セル番地まで調べたい場合は、非表示セルも含めたコピー方法で表を別の場所に移動させてから処理したり、表に行番号列を加えてからワークシート関数VLOOKUPを使うなども考えられます。

Excel-VBA 第一日曜日が何日かを調べる Weekday  

日付をWeekday 関数で曜日を調べます。vbSunday なら日曜日。

Sub FstSunday()
    Dim i As Long
    Dim lngYear As Long
    Dim lngMonth As Long
    Dim strDate As String
    Dim myWeekDay As String
    
    lngYear = Val(Range("C5").Value) '年
    lngMonth = Val(Range("C6").Value) '月
    
    For i = 1 To 7
    
        strDate = lngYear & "/" & lngMonth & "/" & i
        
        myWeekDay = Weekday(strDate)
        
        If myWeekDay = vbSunday Then
        
            Range("C8").Value = i '第一日曜日の日
            
            Exit For
        
        End If
    
    Next i

End Sub

Excel-VBA 閏年(うるう年)を判定 Day DateAdd

閏年は、調べたい年の、3月1日の前日の日にちを調べて、29日かどうかで判定する。

Sub 閏年判定()
    Dim lngYear As Long
    Dim lngFebDay As Long
    
    lngYear = Val(Range("C5").Value) '年
    
    lngFebDay = Day(DateAdd("d", -1, lngYear & "/3/1"))

    If lngFebDay = 29 Then
        Range("C9").Value = 1 '閏年
    Else
        Range("C9").ClearContents
    End If

End Sub


Excel-VBA セルに算式が入っているかどうか調べる HasFormulaプロパティ 

セルに算式が入っているかどうか調べたい。

セルの HasFormula プロパティが True なら、セルに算式が入っています

算式が入っていたらユーザーフォームのテキストボックのBackColorを変えてロックをかけたい。
(ロックするのではなく、Enabled = False にしてもいいが、文字が見えにくくなるね・・・)

ユーザーフォームのテキスボックスに1行分のデータを全て表示させるプログラムです。
「lng開始列」変数は、表の左端(開始列)を入れます。
「strLockColer」変数は、セルに数式が入っていた時のBackColor
「strUnLockColer」変数は、セルに数式が入っていなかった時のBackColor


 Sub UFinit()
'行が変わる度に、ユーザーフォームの内容をリフレッシュする

    Dim lngTargetRow As Long
    Dim i As Long, j As Long
        
    lngTargetRow = ActiveCell.Row

    With f

        j = 0
        For i = 1 To lngField
           .Controls("TextBox" & i).Text = Cells(lngTargetRow, lng開始列 + j).Text
           
           If Cells(lngTargetRow, lng開始列 + j).HasFormula = True Then
           
            .Controls("TextBox" & i).BackColor = strLockColer
            .Controls("TextBox" & i).Locked = True
           
           Else
           
            .Controls("TextBox" & i).BackColor = strUnLockColor
            .Controls("TextBox" & i).Locked = False
           
           End If
           
           j = j + 1
        Next i

    End With
    
End Sub

Excel-VBA テキスボックスにTab(タブ)が入ってしまい移動できない

私が困った事なので、自分用のメモとして書いておきます。

次のような問題が何度かありました。
------------------------------
ユーザーフォームに複数のテキスボックスを設置。
テキストボック間をTabキーで移動したいのに、Tabキーを押すと、テキスボックスの文字列にTabスペースが入ってしまう。
------------------------------

そこで、調べると次のような方法で回避できることが分かりました。

ユーザーフォームをNewを使ってひらく。

Public f As UserForm1

Sub ユーザーフォーム表示()

    Set f = New UserForm1
    f.Show

End Sub

ユーザーフォームが開いてからは、UserForm1. ~ と書かずに、f. ~ を使います。
例としては、こんな感じ

With f

    For i = 1 To lngField
        .Controls("TextBox" & i).BackColor = strLockColer
        .Controls("TextBox" & i).Locked = True
    Next i

End With
 
そして、ブックを閉じる時には、
fに、Nothing しています。

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set f = Nothing
End Sub


念のため、TextBoxのAfterUpdateの際に、ReplaceでTabを取り除く処理も入れています。

    'テキスボックスにTABが入ったら取り外す
    strValue = Me.Controls("TextBox" & TBNo).Value
    strValue = Replace(strValue, vbTab, "")
    Me.Controls("TextBox" & TBNo).Value = strValue

TBNoは、テキスボックスの番号が入った変数です

以上です。
 

Excel-VBA フラグ用の変数によりイベントをぬける(イベントをキャンセル、イベントを止める、イベントからぬける)

予測していなかったところでイベントが発生して困ることがあります。

例えば、セルの選択が変更される度にイベントが発生し、ワークシートモジュールの
Worksheet_SelectionChange というプロシージャが実行されてしまいますね。

他のマクロからセルを選択する度に、このプロシージャが動いてしまいます。

そこで、このプロシージャ内の一行目に、ある変数がTrueだったら、すぐにマクロをぬけるように書いておきます。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'フラグ用の変数がTrueの時は、すぐにプロシージャをぬける
    If blnFlag = True Then Exit Sub
    
    MsgBox "セルが変更される度にメッセージボックスが表示される", vbInformation

End Sub


標準モジュールでは、Boolean型の Public変数、blnFlag を定義しています。(変数名は自由に)

下の TEST1プロシージャは、セル範囲をコピーしてペーストしているだけです。はじめに変数にTrueにし、最後にFalseに戻しています。

Public blnFlag As Boolean

Sub TEST1()

    'フラグ用の変数を作りTrueにしておく
    blnFlag = True

    'コピーしてペーストするだけ
    Range("D5:G5").Select
    Selection.Copy
    Range("D10").Select
    ActiveSheet.Paste

    'フラグ用の変数を作りFalseに戻す
    blnFlag = False

End Sub

これで、 TEST1プロシージャ内で、セルを選択しても、Worksheet_SelectionChang をすぐにぬけてくれます。

Excel-VBA 複数のワークシート内に点在するセルの場所を管理し、管理表をもとにセルのデータを消去する

複数のワークシート内に点在するセルのデータを消去したい場合があります。

そんな時、VBAのプログラム内で、セルを指定してクリアする処理を沢山書く必要はありません。
後でセルの位置が変更になったり、増えたり、減ったりという場合に、いちいちプログラムを見直すだけで大変です。

そこで、ワークシート内に、消去したいシート名と、セル範囲(レンジ)の管理表を作ってしまいます。
その表を元に、下のプログラムを実行するだけで済みます。

vbaで消去

-----------------------------------------

'管理表のあるワークシート名「Work」を変数に入れる
'シート名が変わった時に、ここだけ直せば済む
Public Const ShtWork As String = "Work"

Sub All_DataClear()
    Dim i As Long, lngLastRow As Long
    Dim strMySheet As String, strMyRange As String
    
    '画面の動きを止めておく
    Application.ScreenUpdating = False
    
    'データ消去表の最終行を求める
    lngLastRow = Sheets(ShtWork).Cells(Rows.Count, "H").End(xlUp).Row
    
    '5行目から最終行まで処理を繰り返す
    For i = 5 To lngLastRow
    
        'シート名の取得
        strMySheet = Sheets(ShtWork).Cells(i, "H").Value
        
        '消去するレンジを取得
        strMyRange = Sheets(ShtWork).Cells(i, "I").Value
    
        '取得したシートのレンジをクリアする
        Sheets(strMySheet).Unprotect
        Sheets(strMySheet).Select
        Sheets(strMySheet).Range(strMyRange).Select
        Selection.ClearContents
    
    Next i
    
End Sub
 

Excel VBA教室 4 複数のマクロを続けて実行する(マクロを組み合わせて一つのマクロを作る)

bizvba_160
例えば、マクロ記録機能を使い、3つのマクロ Macro1, Macro2, Macro3 を作ったとします。

これを実行するのに、Macro1を実行して、次に、Macro2を実行して、Macro3を実行して・・・とやる必要はありません。

ここでは、複数のマクロを続けて実行するマクロを作ります。
 

とっても簡単なマクロですが、後に、様々な処理のマクロを組み合わせて作成する為の基本となります。


Sub Macro1()
    Range("D4").Select
    Selection.Copy
    Range("E4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub


Sub Macro2()
    Range("D4").Select
    Selection.Copy
    Range("E5:F5").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub


Sub Macro3()
    Range("D6").Select
    Selection.Copy
    Range("E6:G6").Select
    ActiveSheet.Paste
    Selection.Font.Bold = True
End Sub

これを実行するのに、Macro1を実行して、次に、Macro2を実行して、Macro3を実行して・・・とやる必要はありません。

次のように、Macro名を自由に決めて、Sub マクロ名() ~ End Sub の間に、続けて実行したいマクロ名を Call してあげます。

Sub Macroの統合()
    Call Macro1
    Call Macro2
    Call Macro3
End Sub

「Macroの統合」マクロを実行すれば、Macro1, Macro2, Macro3 が続けて実行されます。簡単ですね。

Call は次のように省略できますが、Call が付いている事で、他のマクロを呼び出していることが視覚的に分かりやすくなりますし、他のマクロを呼び出している箇所を検索する事もできるようになりますので、省略しない方が良いです。

Sub Macroの統合()
    Macro1
    Macro2
    Macro3
End Sub

マクロを分割して作成しておくと、各マクロの実行順序が変わった場合にも変更が簡単です。
また、他のマクロに共通して利用できる場合もあり便利です。

Excel-VBA Workbook_Open の中で他のブックをActivateしたい時は別のサブルーチンとしてCallしないとエラーになる

ブックを起動する際に動く、Workbook_Open の中で他のファイルをActivateするとエラーになる。
その場合は、他のファイルをAcivateする処理の部分を、別のサブルーチンとして作り Call すればエラーにならない。

下の例では、Workbook_Open の中で、K1.xlsm をOpenし、K1.xlsmからデータをCopyしようとしている。
その際、Windows("K1.xlsm").Activate でエラーになる。

Private Sub Workbook_Open()
    
    Dim myFile As String
    Dim myPath As String
    
    myFile = Application.ThisWorkbook.Name
    myPath = Application.ThisWorkbook.Path
    
    ChDir myPath
    Workbooks.Open Filename:=myPath & "\" & "K1.xlsm"
    
    Windows(myFile).Activate

( 省略 )

    '----- ↓ここでエラーになる -----

    Windows("K1.xlsm").Activate
    Sheets("Sheet1").Select
    Range("A285:B500").Select
    Selection.Copy

    Windows(myFile).Activate
    Sheets("Sheet1").Select
    Range("A285").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

( 省略 )

End Sub



そこで、下のように、エラーとなる部分をサブルーチンとして Call することでエラーを回避できる

Private Sub Workbook_Open()
    
    Dim myFile As String
    Dim myPath As String
    
    myFile = Application.ThisWorkbook.Name
    myPath = Application.ThisWorkbook.Path
    
    ChDir myPath
    Workbooks.Open Filename:=myPath & "\" & "K1.xlsm"
    
    Windows(myFile).Activate

( 省略 )

    call MacroK1

( 省略 )

End Sub

Sub MacroK1()
    Dim myFile As String
    
    myFile = Application.ThisWorkbook.Name
    
    Windows("K1.xlsm").Activate
    Sheets("Sheet1").Select
    Range("A285:B500").Select
    Selection.Copy
    Windows(myFile).Activate
    Sheets("Sheet1").Select
    Range("A285").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    
End Sub

 

Excel VBA教室 3 VBA(Visual Basic for Applications)とは

bizvba_160Excelには、作業を自動化するためのツール、マクロがあります。

このマクロは、VBA というプログラム言語で記述されています。

VBA(Visual Basic for Applications)は、Officeアプリケーション用のプログラム言語で、Visual Basic の文法を引き継いでいます。


マクロは、同じ作業を繰り返す場合や、複数の操作をまとめて実行するのに非常に便利!!

正しい作業をマクロにしてしまえば、ミスもなくなりますし、操作を人に任すことも可能になります。

マクロはボタンで実行することもできますし、ブックを開いた時、特定のセルを選択した時など、操作に応じて実行することも可能です。





記事検索
Excel VBA ノートについて(注意事項)
このExcel VBA ノートは、Hide Tamura の個人的なVBAノートです。プログラムを再利用したり、コピペで入力の手間を省く為に作ったネット上のノートです。 その為、詳しい解説は書いておりません。エラー等のトラブルには責任は負いません。利用者の環境に合わせて書き換えてご利用ください。
ExcelVBA教室
Excel VBA 担当 Hide Tamura

Excel95? マクロシートがあった頃からExcelVBAを独学で利用しています。現在は、様々な企業様からVBAによる業務効率UPの為のお仕事を頂いております。既にお使いになっているファイルにVBAを利用することで、作業が楽になったり、時間も大幅に短縮されたなど、大変喜ばれています。

■VBA Expert
VBA Expert Standard Crown
ExcelVBA Standard(Odyssey)
Access VBA Standard(Odyssey)
Excel2002 VBA Standard(日本VBA協会)
■MICROSOFT OFFICE USER SPECIALIST
Microsoft Excel version2002 Expert
Microsoft Excel version2002




最新記事
Excelで作る経営計画
Excelで利益計画を立てましょう!会社にいくらの利益が必要で、その為の売上高は?

Excelで作る経営計画
Excel 関数 ノート
Excel関数を中心に、Excelの便利機能や、意外としらない使い方など書いていきます。

Excel 関数 ノート
Access VBAノート
Hide Tamura の個人的なVBAノートです。

頻繁に使うVBAコードなどを記録しコピペして使う為に作りました。お役に立てるようでしたら、お使いください。

Access VBAノート
アクセスカウンター

    • ライブドアブログ