【VBA】テクニック

オブジェクト格納

    'ワークブック
    Dim wb As Workbook
    Set wb = Workbooks("book1.xlsx")
    wb.sheets(1).range("A1") = "バナナ"

    'ワークシート
    Dim ws As Worksheet
    Set ws = Workbooks("book1.xlsx").Sheets("Sheet2")
    ws.range("A1") = "バナナ"

    'Range
    Dim rg As Range
    Set rg = Workbooks("book1.xlsx").Sheets("Sheet1").range("A1:B2")
    rg = "バナナ"

セルのカタマリ取得

    Dim tmpRange As Range
    set tmpRange = Worksheets(1).Range("A1").CurrentRegion

Excel関数を使用する

WorksheetFunctionを使用する

    Dim result As Integer
    result = WorksheetFunction.Match(5, Range("A1:A5"), 0)

Rangeからシート名、ブック名取得

    Set rg = Range("A1")
    'シート名
    rg.Parent.name
    'ブック名
    rg.Parent.Parent.name

画面更新を止める(処理高速化)

'画面更新の非表示
Application.ScreenUpdating = False
'画面更新の非表示解除
Application.ScreenUpdating = True

ステータスバーに文字を表示

'表示
Application.StatusBar = "メッセージ"
'元に戻す
Application.StatusBar = False

セルの値をクリア

行単位(最終行まで)
'2行目~最終行までクリア
Sheets(1).Rows(2 & ":" & Rows.Count).ClearContents
列と行指定
Dim edDellRow As Long
Dim dellTgtSheet As Worksheet
'********************PARAM********************
Set dellTgtSheet = Sheets(1)    'クリア対象シート
Const stDellCol = 1             'クリア開始列
Const edDellCol = 5             'クリア終了列
Const stDellRow = 2             'クリア開始行
edDellRow = Rows.Count          'クリア終了行
'*********************************************
With dellTgtSheet
    .Range(.Cells(stDellRow, stDellCol), .Cells(edDellRow, edDellCol)).ClearContents
End With
シート全体
Sheets(1).Cells.ClearContents

セル内容をコピペ

Dim arr_Temp() As Variant
Dim rng_Inp As Variant
Dim rng_Out As Variant
'********************PARAM********************
Set rng_Inp = Sheets(1).Range("A1:E2")  '入力範囲
Set rng_Out = Sheets(1).Range("A5")     '出力場所
'*********************************************
arr_Temp = rng_Inp.Value
rng_Out.Resize(UBound(arr_Temp, 1), UBound(arr_Temp, 2)).Value = arr_Temp

エラートラップ(On Error GoTo)

'汎用エラートラップ
On Error GoTo Err
~~~
Exit Sub
Err:
    MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラー内容:" & Err.Description, vbOKOnly + vbCritical
'エラー無視
On Error Resume Next
'エラー無視解除
On Error Goto 0

CSV読み込み→type配列(簡易版)

「,」「"」が含まれていれば使えない

Type typPerson
    id As String
    name As String
End Type

Sub test()

    Dim arry(20) As typPerson
    Dim i As Long: i = 0
    
    Open "C:\Users\user\Desktop\新しいフォルダー (2)\加藤.csv" For Input As #1

    Do Until EOF(1)
        Input #1, _
            arry(i).id, _
            arry(i).name
        i = i + 1
    Loop
    Close #1

End Sub

INIファイル活用

(書き込みのポイント)
・INIファイルの文字コードはShift-JISである必要がある
・書き込み時、ファイルがなければ自動で作成される
・既存のキーを書き込むと値が上書きされる

'INIファイル読込み
Private Declare Function WritePrivateProfileString Lib "kernel32" _
    Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
     ByVal lpString As Any, ByVal lpFileName As String) As Long

'INIファイル書き込み
Private Declare Function GetPrivateProfileString Lib "kernel32" _
    Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
     ByVal lpKeyName As Any, ByVal lpDefault As String, _
     ByVal lpReturnedString As String, ByVal nSize As Long, _
     ByVal lpFileName As String) As Long

'INIファイル書込み
Sub WriteIni()

    Const fileName = "C:\Users\user\Desktop\新しいフォルダー\test.ini"
    
    'セクション、キー、値、保存場所を引数に指定
    Call WritePrivateProfileString("Aさん", "年齢", "33", fileName)
    Call WritePrivateProfileString("Aさん", "身長", "170", fileName)

    Call WritePrivateProfileString("Bさん", "年齢", "28", fileName)
    
    'キーの削除
    Call WritePrivateProfileString("Bさん", "年齢", 0&, fileName)
    'セクションの削除
    Call WritePrivateProfileString("Bさん", 0&, 0&, fileName)
    
End Sub

'INIファイル読込み
Sub ReadIni()
    
    Dim rtnStr As String
    Dim rtnCD As Integer
    Const fileName = "C:\Users\user\Desktop\新しいフォルダー\test.ini"
    
    rtnStr = Space$(256)
    'セクション、キー、ないときの値、戻り値の格納先、サイズ、ファイル場所を引数に指定
    rtnCD = GetPrivateProfileString("Aさん", "年齢あ", "", rtnStr, 255, fileName)
    rtnStr = Left$(rtnStr, InStr(rtnStr, Chr$(0)) - 1)
    
    If rtnCD = 0 Then MsgBox "ERROR"
    
End Sub