【Excel VBA】よく使うコードまとめ

VBA開発をする時、基本的で簡単なコードであれば覚えているのですが、たいていググるか昔のファイルを開いてコピペしちゃってます。

その度に参考サイトにアクセスしたりファイルを開くのがめんどくさいので、この記事にまとめておくことにしました。

別記事に登場するコード
ファイルを開く
ファイルを新規作成・保存する
1. 新規ブックを作成して保存する
2. テキストファイルを作成して出力
ワークシートの操作
テーブル
1. ソート
セル
変数における処理

別記事に登場するコード

内容	リンク
月ごとの日付を算出	Excelでカレンダーを自動作成するVBAマクロ
最終行・最終列の取得	Excel VBAでシフト表自動作成ツール
シートの複製	Excel VBAでシフト表自動作成ツール
配列の宣言・格納	Excel VBAでシフト表自動作成ツール
Randomizeで配列内のデータをシャッフル	Excel VBAでシフト表自動作成ツール
罫線の設定	Excel VBAでシフト表自動作成ツール
IEを使い情報の取得と入力	Excel VBAとIEでウェブページの情報を取得する
テーブルへ行追加	【Excel VBA】週次集計と月間集計を作成する仕入・売上表
印刷範囲の設定	【Excel VBA】週次集計と月間集計を作成する仕入・売上表
フィルタをかける	【Excel VBA】週次集計と月間集計を作成する仕入・売上表
新規ブックを開く	【Excel VBA】週次集計と月間集計を作成する仕入・売上表
セル範囲をコピペ	【Excel VBA】週次集計と月間集計を作成する仕入・売上表
シートを削除	【Excel VBA】週次集計と月間集計を作成する仕入・売上表
PDFに出力	【Excel VBA】週次集計と月間集計を作成する仕入・売上表

ファイルを開く

Excelブックとしてファイルを開く

Excelブックとして開いて問題のないデータであれば、この方法が最も確実でわかりやすいです。

Sub sample()
    Dim openFileName As String  'ファイル名'
    
    '開きたいファイルのパスと名前を指定'
    openFileName = ThisWorkbook.Path & "\sample.csv"    'Macでは「\」ではなく「/」を使う'
    
    'ファイルが見つからなければファイルを選択して開く'
    If Dir(openFileName) = "" Then
        openFileName = Application.GetOpenFilename("CSV（コンマ区切り）, *.csv")    'Macでは引数は記述しない'
        
        'キャンセルボタンが押されたら処理中止'
        If openFileName = "False" Then
            Exit Sub
        End If
    End If
    
    'ファイルを開く'
    Workbooks.Open openFileName
    
    '処理を記述'
    
    '開いたファイルを閉じる'
    ActiveWorkbook.Application.CutCopyMode = False  'カットコピーモードを解除'

    ActiveWorkbook.Close SaveChanges:=False         '開いたファイルを閉じる'
End Sub

Sub sample()

Dim openFileName As String 'ファイル名'

'開きたいファイルのパスと名前を指定'

openFileName = ThisWorkbook.Path & "\sample.csv" 'Macでは「\」ではなく「/」を使う'

'ファイルが見つからなければファイルを選択して開く'

If Dir(openFileName) = "" Then

openFileName = Application.GetOpenFilename("CSV（コンマ区切り）, *.csv") 'Macでは引数は記述しない'

'キャンセルボタンが押されたら処理中止'

If openFileName = "False" Then

Exit Sub

End If

'ファイルを開く'

Workbooks.Open openFileName

'処理を記述'

'開いたファイルを閉じる'

ActiveWorkbook.Application.CutCopyMode = False 'カットコピーモードを解除'

ActiveWorkbook.Close SaveChanges:=False '開いたファイルを閉じる'

End Sub

このマクロが記録されたExcelファイルと同じフォルダに「sample.csv」があれば開き、無ければユーザーがファイルを選択して開きます。プロシージャの最後で開いたファイルは保存せずに閉じます。

GetOpenFilenameメソッドの引数で開くファイル形式を限定することができます。以下の３つだけ使えればいいでしょう。

ちなみにこの引数はMacではエラーとなり指定できません。

ファイル形式	引数
Excel（xls、xlsx、xlsm）	Excel ブック,.xls
CSVファイル	CSV（コンマ区切り）,*.csv
テキストファイル（TSV）	テキスト（タブ区切り）,*.txt

CSVファイルをLine Inputで読み込む

Excelでは15桁を超える数値は扱えません。16桁以降はすべて0に変換されてしまいます。

16桁以降も正常に表示するには文字列として扱う必要があるのですが、そういったデータが含まれるCSVファイルをExcelで開いてしまうと変換後のデータしか取り出せません。

そこでLine Inputでテキストデータ読み込み、文字列としてExcelに出力するという方法があります。

Sub sample()
    Dim openFileName As String  'ファイル名'
    Dim strLine As String       '１行分のデータ'
    Dim strArray() As String    'カンマで分割したデータを格納'
    
    '開きたいファイルのパスと名前を指定'
    openFileName = ThisWorkbook.Path & "\sample.csv"    'Macでは「\」ではなく「/」を使う'
    
    'ファイルが見つからなければファイルを選択して開く'
    If Dir(openFileName) = "" Then
        openFileName = Application.GetOpenFilename("CSV, *.csv")    'Macでは引数は記述しない'
        
        'キャンセルボタンが押されたら処理中止'
        If openFileName = "False" Then
            Exit Sub
        End If
    End If
    
    '「1」としてファイルを開く'
    Open openFileName For Input As #1
    
    '最後の行まで繰り返す'
    Do Until EOF(1)
        Line Input #1, strLine   '１行分のデータを取得'
        If strLine <> "" Then
            strArray = Split(strLine, ",")   'カンマで分割'
            
            For i = 0 To UBound(strArray)   '１列ずつ処理'
                '処理を記述'
                Debug.Print Replace(strArray(i), """", "")  'ダブルクォートを除去'
            Next
            
        End If
    Loop
    
    Close #1    '閉じる'
End Sub

Sub sample()

Dim openFileName As String 'ファイル名'

Dim strLine As String '１行分のデータ'

Dim strArray() As String 'カンマで分割したデータを格納'

'開きたいファイルのパスと名前を指定'

openFileName = ThisWorkbook.Path & "\sample.csv" 'Macでは「\」ではなく「/」を使う'

'ファイルが見つからなければファイルを選択して開く'

If Dir(openFileName) = "" Then

openFileName = Application.GetOpenFilename("CSV, *.csv") 'Macでは引数は記述しない'

'キャンセルボタンが押されたら処理中止'

If openFileName = "False" Then

Exit Sub

End If

'「1」としてファイルを開く'

Open openFileName For Input As #1

'最後の行まで繰り返す'

Do Until EOF(1)

Line Input #1, strLine '１行分のデータを取得'

If strLine <> "" Then

strArray = Split(strLine, ",") 'カンマで分割'

For i = 0 To UBound(strArray) '１列ずつ処理'

'処理を記述'

Debug.Print Replace(strArray(i), """", "") 'ダブルクォートを除去'

End If

Loop

Close #1 '閉じる'

End Sub

なお、数値を文字列として処理するには文字列型で宣言した変数に格納したり、出力先セルの書式設定を文字列にしておくなどがありますが、勝手に数値に変えられてしまいがちです。

もっとも確実なのは頭に「’（シングルクォート）」を付けると強制的に文字列として扱われるので、「’ & strArray(i)」みたいな感じでセルに出力するといいと思います。

カンマ入りのCSVファイルをTSVファイルに変換する

CSVはComma Separated Valueの略で、要は「,（カンマ）」でデータを区切った形式です。

上記の方法ではSplit関数を使ってカンマでデータを分割していたのですが、区切りとしてはでなく文字列としてカンマが含まれていたら、値の途中でデータを区切ってしまうことになります。

エクセルVBAでデータにカンマが含まれてしまっているCSVを取り込む

そこで、こちらの記事を参考にし、区切りのカンマをタブ記号に変換してTSVにします。

Sub sample()
    Dim openFileName As String  'ファイル名'
    Dim strLine As String       '１行分のデータ'
    Dim strArray() As String    'タブ記号で分割したデータを格納'
    
    '開きたいファイルのパスと名前を指定'
    openFileName = ThisWorkbook.Path & "\sample.csv"    'Macでは「\」ではなく「/」を使う'
    
    'ファイルが見つからなければファイルを選択して開く'
    If Dir(openFileName) = "" Then
        openFileName = Application.GetOpenFilename("CSV, *.csv")    'Macでは引数は記述しない'
        
        'キャンセルボタンが押されたら処理中止'
        If openFileName = "False" Then
            Exit Sub
        End If
    End If
    
    '「1」としてファイルを開く'
    Open openFileName For Input As #1
    
    '最後の行まで繰り返す'
    Do Until EOF(1)
        Line Input #1, strLine   '１行分のデータを取得'
        If strLine <> "" Then
            strArray = Split(csvToTsv(strLine), vbTab)   'タブ記号で分割'
            
            For i = 0 To UBound(strArray)   '１列ずつ処理'
                '処理を記述'
                Debug.Print Replace(strArray(i), """", "")  'ダブルクォートを除去'
            Next
            
        End If
    Loop
    
    Close #1    '閉じる'
End Sub

Function csvToTsv(ByVal str As String) As String
    Dim strTemp As String
    Dim quotCount As Long
    Dim l As Long
    
    For l = 1 To Len(str)
        strTemp = Mid(str, l, 1)
        If strTemp = """" Then
            quotCount = quotCount + 1
        ElseIf strTemp = "," Then
            If quotCount Mod 2 = 0 Then
                str = Left(str, l - 1) & vbTab & Right(str, Len(str) - l)
            End If
        End If
    Next l
    
    csvToTsv = str
End Function

Sub sample()

Dim openFileName As String 'ファイル名'

Dim strLine As String '１行分のデータ'

Dim strArray() As String 'タブ記号で分割したデータを格納'

'開きたいファイルのパスと名前を指定'

openFileName = ThisWorkbook.Path & "\sample.csv" 'Macでは「\」ではなく「/」を使う'

'ファイルが見つからなければファイルを選択して開く'

If Dir(openFileName) = "" Then

openFileName = Application.GetOpenFilename("CSV, *.csv") 'Macでは引数は記述しない'

'キャンセルボタンが押されたら処理中止'

If openFileName = "False" Then

Exit Sub

End If

'「1」としてファイルを開く'

Open openFileName For Input As #1

'最後の行まで繰り返す'

Do Until EOF(1)

Line Input #1, strLine '１行分のデータを取得'

If strLine <> "" Then

strArray = Split(csvToTsv(strLine), vbTab) 'タブ記号で分割'

For i = 0 To UBound(strArray) '１列ずつ処理'

'処理を記述'

Debug.Print Replace(strArray(i), """", "") 'ダブルクォートを除去'

End If

Loop

Close #1 '閉じる'

End Sub

Function csvToTsv(ByVal str As String) As String

Dim strTemp As String

Dim quotCount As Long

Dim l As Long

For l = 1 To Len(str)

strTemp = Mid(str, l, 1)

If strTemp = """" Then

quotCount = quotCount + 1

ElseIf strTemp = "," Then

If quotCount Mod 2 = 0 Then

str = Left(str, l - 1) & vbTab & Right(str, Len(str) - l)

End If

Next l

csvToTsv = str

End Function

文字コードがUTF-8のCSVファイルを開く

Excelで文字コードがUTF-8のファイルを開くと文字化けします。

文字化けよさようなら！エクセルVBAでUTF-8のCSVを読み込む方法

こちらの記事を参考にし、ADODB.Streamというオブジェクトに入れて文字化けを避けます。

ADODB.Streamを使うには事前準備が必要です。

VBEを起動
メニューの「ツール」から「参照設定」を開く
Microsoft ActiveX Data Objects ○.○ Libraryにチェックを入れる

Sub sample()
    Dim openFileName As String  'ファイル名'
    Dim strBuf As String        '読み込んだデータ'
    Dim strLine() As String     '１行分のデータ'
    Dim strArray() As String    'カンマで分割したデータを格納'
    
    '開きたいファイルのパスと名前を指定'
    openFileName = ThisWorkbook.Path & "\sample.csv"    'Macでは「\」ではなく「/」を使う'
    
    'ファイルが見つからなければファイルを選択して開く'
    If Dir(openFileName) = "" Then
        openFileName = Application.GetOpenFilename("CSV, *.csv")    'Macでは引数は記述しない'
        
        'キャンセルボタンが押されたら処理中止'
        If openFileName = "False" Then
            Exit Sub
        End If
    End If
    
    'ADODB.Streamにデータを格納'
    Set adoSt = CreateObject("ADODB.Stream")
    With adoSt
        .Charset = "UTF-8"
        .Open
        .LoadFromFile openFileName
        strBuf = .ReadText
        .Close
    End With
    
    '読み込んだデータを改行で区切る'
    strLine = Split(strBuf, vbCrLf)
    
    'すべての行を処理'
    For i = 0 To UBound(strLine)
        If strLine(i) <> "" Then
            strArray = Split(strLine(i), ",")   'カンマで分割'
            
            '処理を記述'
            Debug.Print Replace(strLine(0), """", "")
        End If
    Next
    
End Sub

Sub sample()

Dim openFileName As String 'ファイル名'

Dim strBuf As String '読み込んだデータ'

Dim strLine() As String '１行分のデータ'

Dim strArray() As String 'カンマで分割したデータを格納'

'開きたいファイルのパスと名前を指定'

openFileName = ThisWorkbook.Path & "\sample.csv" 'Macでは「\」ではなく「/」を使う'

'ファイルが見つからなければファイルを選択して開く'

If Dir(openFileName) = "" Then

openFileName = Application.GetOpenFilename("CSV, *.csv") 'Macでは引数は記述しない'

'キャンセルボタンが押されたら処理中止'

If openFileName = "False" Then

Exit Sub

End If

'ADODB.Streamにデータを格納'

Set adoSt = CreateObject("ADODB.Stream")

With adoSt

.Charset = "UTF-8"

.Open

.LoadFromFile openFileName

strBuf = .ReadText

.Close

End With

'読み込んだデータを改行で区切る'

strLine = Split(strBuf, vbCrLf)

'すべての行を処理'

For i = 0 To UBound(strLine)

If strLine(i) <> "" Then

strArray = Split(strLine(i), ",") 'カンマで分割'

'処理を記述'

Debug.Print Replace(strLine(0), """", "")

End If

End Sub

MacでUTF-8のCSVファイルを読み込む

上記のADODB.StreamはMac版ではおそらく対応していません。

VBA CSV ファイルの読み込み (Workbooks.OpenText 関数を使う)

代替方法はこちらの記事を参考にしました。

Sub sample()
    Dim openFileName As String  'ファイル名'
   
    '開きたいファイルのパスと名前を指定'
    openFileName = ThisWorkbook.Path & "\sample.csv"    'Macでは「\」ではなく「/」を使う'
    
    'ファイルが見つからなければファイルを選択して開く'
    If Dir(openFileName) = "" Then
        openFileName = Application.GetOpenFilename("CSV, *.csv")    'Macでは引数は記述しない'
        
        'キャンセルボタンが押されたら処理中止'
        If openFileName = "False" Then
            Exit Sub
        End If
    End If
    
    'ファイルを開く'
    Call Workbooks.OpenText(openFileName, Origin:=65001, Comma:=True)
    
    '処理を記述'
    
    '開いたファイルを閉じる'
    ActiveWorkbook.Application.CutCopyMode = False  'カットコピーモードを解除'
    ActiveWorkbook.Close SaveChanges:=False         '開いたファイルを閉じる'
End Sub

Sub sample()

Dim openFileName As String 'ファイル名'

'開きたいファイルのパスと名前を指定'

openFileName = ThisWorkbook.Path & "\sample.csv" 'Macでは「\」ではなく「/」を使う'

'ファイルが見つからなければファイルを選択して開く'

If Dir(openFileName) = "" Then

openFileName = Application.GetOpenFilename("CSV, *.csv") 'Macでは引数は記述しない'

'キャンセルボタンが押されたら処理中止'

If openFileName = "False" Then

Exit Sub

End If

'ファイルを開く'

Call Workbooks.OpenText(openFileName, Origin:=65001, Comma:=True)

'処理を記述'

'開いたファイルを閉じる'

ActiveWorkbook.Application.CutCopyMode = False 'カットコピーモードを解除'

ActiveWorkbook.Close SaveChanges:=False '開いたファイルを閉じる'

End Sub

OpenTextメソッドの第２引数で開く文字コードを指定します。

文字コード	値
Shift-JIS	932
UTF-8	65001

また、第３引数では区切り文字を指定できます。

区切り文字	値
カンマ	Comma:=True
タブ	Tab:=True
セミコロン	Semicolon:=True
スペース	Space:=True
その他	Other:=True, OtherChar:=”a”

ディレクトリ内のファイルを順番に開く

指定のディレクトリ内のファイルを順番に開く方法です。

VBA：フォルダ内のファイルを順次処理

こちらの記事を参考にしています。

Sub sample()
    Dim path, fso, file, files
    Dim wb As Workbook

    path = ThisWorkbook.path & "\sample"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set files = fso.GetFolder(path).files

    For Each file In files
        Set wb = Workbooks.Open(file)
        
        '処理を記述'
        
        Application.EnableEvents = False
        ActiveWorkbook.Close SaveChanges:=True
    Next file
End Sub

Sub sample()

Dim path, fso, file, files

Dim wb As Workbook

path = ThisWorkbook.path & "\sample"

Set fso = CreateObject("Scripting.FileSystemObject")

Set files = fso.GetFolder(path).files

For Each file In files

Set wb = Workbooks.Open(file)

'処理を記述'

Application.EnableEvents = False

ActiveWorkbook.Close SaveChanges:=True

Next file

End Sub

マクロを記録したExcelファイルと同じディレクトリ内にある「sample」ディレクトリ内にあるファイルを順番に開きます。

ファイルを新規作成・保存する

新規ブックを作成して保存する

新規ブックを開いて保存します。また、既存のファイルを改めて名前を付けて保存することも可能です。

Sub sample()
    Dim tmpName As String       'デフォルトの保存名'
    Dim saveFileName As String  '保存名'
    
    '新規ブックを作成'
    Workbooks.Add
    
    'デフォルトの保存名'
    tmpName = "sample"
    
    '名前を付けて保存'
    saveFileName = Application.GetSaveAsFilename(tmpName, FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
    
    'キャンセルボタンを押されなければ保存'
    If saveFileName <> "False" Then
        ActiveWorkbook.SaveAs Filename:=saveFileName, FileFormat:=xlNormal
    End If
End Sub

Sub sample()

Dim tmpName As String 'デフォルトの保存名'

Dim saveFileName As String '保存名'

'新規ブックを作成'

Workbooks.Add

'デフォルトの保存名'

tmpName = "sample"

'名前を付けて保存'

saveFileName = Application.GetSaveAsFilename(tmpName, FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")

'キャンセルボタンを押されなければ保存'

If saveFileName <> "False" Then

ActiveWorkbook.SaveAs Filename:=saveFileName, FileFormat:=xlNormal

End If

End Sub

SaveAsメソッドのFileFormatでファイル形式を指定することができます。

ファイル形式	値
Excel	xlNormal
CSV	xlCSV
テキスト	xlText

テキストファイルを作成して出力

テキストファイルとしてファイルを作成するのであれば、かなり処理が速いのでこのやり方がベストです。

Sub sample()
    Dim openFileName As String  'ファイル名'
    
    openFileName = ThisWorkbook.Path & "\sample.txt"
    
    'テキストファイルを新規作成（存在していれば上書き）'
    Open openFileName For Output As #1
    
    Print #1, "hoge"
    Print #1, "fuga"
    Print #1, "piyo"
    
    Close #1
End Sub

Sub sample()

Dim openFileName As String 'ファイル名'

openFileName = ThisWorkbook.Path & "\sample.txt"

'テキストファイルを新規作成（存在していれば上書き）'

Open openFileName For Output As #1

Print #1, "hoge"

Print #1, "fuga"

Print #1, "piyo"

Close #1

End Sub

Printで１行ずつ追記していきます。

ワークシートの操作

シートを探す

Sub シートを探す()
    Dim sheetName As String

    sheetName = "サンプル"

    For i = 1 To Worksheets.Count
        If sheetName = Worksheets(i).name Then
            Worksheets(i).Activate
            Exit For
        End If
    Next
End Sub

Sub シートを探す()

Dim sheetName As String

sheetName = "サンプル"

For i = 1 To Worksheets.Count

If sheetName = Worksheets(i).name Then

Worksheets(i).Activate

Exit For

End If

End Sub

指定の名前がついたシートが見つかればそのシートをアクティブにします。

シートの複製

Sub シートの複製()
    ActiveSheet.Copy Before:=ActiveSheet
End Sub

Sub シートの複製()

ActiveSheet.Copy Before:=ActiveSheet

End Sub

マクロ入りシートを複製しボタンに再登録

シートにマクロが記録されている場合、シートを複製すると登録名が前のシートのままになってしまいますので、複製したシート名で登録し直します。

Sub マクロ入りシートを複製しボタンに再登録()
    Dim macroName As String 'マクロ登録名'
    
    Workbooks.Add
    ThisWorkbook.ActiveSheet.Copy Before:=ActiveWorkbook.Worksheets(1)

    For i = 1 To ActiveSheet.DrawingObjects.Count
        ActiveSheet.DrawingObjects(i).Select
        macroName = Selection.OnAction
        If InStr(macroName, "!") > 0 Then
            macroName = "'" & ActiveWorkbook.Name & "'!" & Mid(macroName, InStr(macroName, "!") + 1, Len(macroName))
            ActiveSheet.DrawingObjects(i).OnAction = macroName
        End If
    Next
End Sub

Sub マクロ入りシートを複製しボタンに再登録()

Dim macroName As String 'マクロ登録名'

Workbooks.Add

ThisWorkbook.ActiveSheet.Copy Before:=ActiveWorkbook.Worksheets(1)

For i = 1 To ActiveSheet.DrawingObjects.Count

ActiveSheet.DrawingObjects(i).Select

macroName = Selection.OnAction

If InStr(macroName, "!") > 0 Then

macroName = "'" & ActiveWorkbook.Name & "'!" & Mid(macroName, InStr(macroName, "!") + 1, Len(macroName))

ActiveSheet.DrawingObjects(i).OnAction = macroName

End If

End Sub

シートを削除

Sub シートを削除()
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
End Sub

Sub シートを削除()

Application.DisplayAlerts = False

ActiveSheet.Delete

Application.DisplayAlerts = True

End Sub

シートを削除する前に警告メッセージが出てくるのを無効化する処理もしておきます。

シートの保護

Sub シートの保護()
    '保護の解除'
    ActiveSheet.Unprotect

    '保護'
    ActiveSheet.Protect
End Sub

Sub シートの保護()

'保護の解除'

ActiveSheet.Unprotect

'保護'

ActiveSheet.Protect

End Sub

マクロ実行時のみシートの保護を解除

Sub マクロ実行時のみシートの保護を解除()
    ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Sub マクロ実行時のみシートの保護を解除()

ActiveSheet.Protect UserInterfaceOnly:=True

End Sub

テーブル

ソート

Sub ソート()
    Range(Cells(2, 1), Cells(100, 5)) _
    .Sort Key1:=Cells(2, 2), order1:=xlAscending, _
          Key2:=Cells(2, 3), order2:=xlDescending
End Sub

Sub ソート()

Range(Cells(2, 1), Cells(100, 5)) _

.Sort Key1:=Cells(2, 2), order1:=xlAscending, _

Key2:=Cells(2, 3), order2:=xlDescending

End Sub

テーブルの先頭はヘッダー行ではなくデータが始まる行を指定します。

昇順	xlAscending
降順	xlDescending

セル

リストを作成する

Sub リスト作成()
    Dim listName As Name    'リスト名'

    'リストが存在したら削除'
    For Each listName In ActiveWorkbook.Names
        If listName.Name = "サンプル" Then
            Range("サンプル").Name.Delete
        End If
    Next

    ActiveWorkbook.Names.Add _
        Name:="サンプル", _
        RefersTo:="=Sheet1!$A$2:$C$10"
End Sub

Sub リスト作成()

Dim listName As Name 'リスト名'

'リストが存在したら削除'

For Each listName In ActiveWorkbook.Names

If listName.Name = "サンプル" Then

Range("サンプル").Name.Delete

End If

ActiveWorkbook.Names.Add _

Name:="サンプル", _

RefersTo:="=Sheet1!$A$2:$C$10"

End Sub

条件付き書式

Sub 条件付き書式()
    '条件付き書式をリセット'
    Range("A1").FormatConditions.Delete

    With Range("A1").FormatConditions.Add(Type:=xlTextString, String:="サンプル", TextOperator:=2)
        .Font.Color = RGB(255, 255, 255)    '文字色'
        .Interior.Color = RGB(255, 0, 0)    '背景色'
    End With
End Sub

Sub 条件付き書式()

'条件付き書式をリセット'

Range("A1").FormatConditions.Delete

With Range("A1").FormatConditions.Add(Type:=xlTextString, String:="サンプル", TextOperator:=2)

.Font.Color = RGB(255, 255, 255) '文字色'

.Interior.Color = RGB(255, 0, 0) '背景色'

End With

End Sub

FormatCondition.Addメソッドの引数で条件が変わります。

入力規則

Sub 入力規則()
    Dim myStr As String 'リストに登録する文字列'

    myStr = "ほげ,ふが,ぴよ"
    With Range("A1").Validation
        .Delete '入力規則をリセット'
        .Add Type:=xlValidateList, Formula1:=myStr
        .ShowError = False  '規則外の入力時のエラー表示'
    End With
End Sub

Sub 入力規則()

Dim myStr As String 'リストに登録する文字列'

myStr = "ほげ,ふが,ぴよ"

With Range("A1").Validation

.Delete '入力規則をリセット'

.Add Type:=xlValidateList, Formula1:=myStr

.ShowError = False '規則外の入力時のエラー表示'

End With

End Sub

変数における処理

現在の日付を文字列として取得

Sub 現在の日付を文字列として取得()
    Dim todayDate As String
    todayDate = Format(Now, "yyyymmdd")
End Sub

Sub 現在の日付を文字列として取得()

Dim todayDate As String

todayDate = Format(Now, "yyyymmdd")

End Sub

日付の計算

Sub 日付の計算()
    Dim setDate As Date
    setDate = "2020/05/01"
    setDate = DateAdd("d", 3, setDate)
End Sub

Sub 日付の計算()

Dim setDate As Date

setDate = "2020/05/01"

setDate = DateAdd("d", 3, setDate)

End Sub

setDateに３日足す例。

DateAddの引き数を変えることで日数や年・月・日・時・分・秒までいける。

特定の文字以下の文字列を取り出す

Sub 特定の文字以下の文字列を取り出す()
    Dim myStr As String

    myStr = "ほげ田　ほげ夫"
    myStr = Right(myStr, Len(myStr) - InStr(myStr, "　"))
End Sub

Sub 特定の文字以下の文字列を取り出す()

Dim myStr As String

myStr = "ほげ田　ほげ夫"

myStr = Right(myStr, Len(myStr) - InStr(myStr, "　"))

End Sub

頭に”$”があるデータから、$より右側を取得。

アルファベットの大文字・小文字を区別しない

Sub 特定の文字以下の文字列を取り出す()
    Dim myStr As String

    myStr = "Hoge"
    Debug.Print UCase(myStr) & "," & LCase(myStr)
End Sub

Sub 特定の文字以下の文字列を取り出す()

Dim myStr As String

myStr = "Hoge"

Debug.Print UCase(myStr) & "," & LCase(myStr)

End Sub

大文字・小文字を区別しないというとニュアンスが違いますが、UCase関数はアルファベットをすべて大文字に変換します。

全角を半角にする

Sub 特定の文字以下の文字列を取り出す()
    Dim myStr As String

    myStr = "ほげホゲＨｏｇｅ"
    Debug.Print StrConv(myStr, vbNarrow)
End Sub

Sub 特定の文字以下の文字列を取り出す()

Dim myStr As String

myStr = "ほげホゲＨｏｇｅ"

Debug.Print StrConv(myStr, vbNarrow)

End Sub

StrConv関数はさまざまな変換ができまして、第２引数をvbNarrowにすることで全角を半角にすることができます。