プログラミング

【コピペOK】ExcelVBA 処理サンプル

Excelマクロを使用するときによく使う処理のサンプルです。

コピペで使えるようになっているので使ってください。

正規表現でバリデーション

Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")

Dim testStr As String
testStr = "090"

Dim patternStr As String
patternStr = "^[0-9]+"

With objRegExp
	.pattern = patternStr
	If(.test(testStr) Then
		#ここに処理を書く
	End If
End With

VBAでSwitch文(Select)

Select Case 変数
    Case 値1
        変数=値1の場合の処理
    Case 値2
        変数=値2の場合の処理
    Case Else
       変数=値1、変数=値2を満たさなかった場合の処理
End Select

VBA 自動計算と再描画 

With Application
    .Calculation = xlCalculationManual      '数式再計算オフ
    .ScreenUpdating = False                 '再描画オフ
End With

With Application
    .Calculation = xlCalculationAutomatic   '数式再計算オン
    .ScreenUpdating = True                  '再描画オン
End With

ファイル選択ダイアログ

Dim strPath As String ' 選択したファイルのパス

With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = "初期パス"
    If .Show = True Then
        strPath = .SelectedItems(1)
    End If
End With

フォルダ選択ダイアログ

Dim strPath As String ' 選択したフォルダのパス

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "初期パス"
    If .Show = True Then
        strPath = .SelectedItems(1)
    End If
End With

最終行の取得

Dim endRow As Long
endRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row

オートフィルタの解除

' wbkはWorkbookオブジェクトのインスタンス
If wbk.Worksheets("ワークシートの名前").FilterMode = True Then
    wbk.Worksheets("ワークシートの名前").ShowAllData
End If

ワークシート存在チェック関数

Private Function isExistWorkSheet(wbk As Workbook, sheetName As String) As Boolean
    Dim ws As Worksheet
    isExistWorkSheet = False
    For Each ws In wbk.Worksheets
        If ws.Name = sheetName Then
            isExistWorkSheet = True
            Exit For
        End If
    Next ws
End Function

確認を表示させずシートなどを消す

With Application
    .DisplayAlerts = False
    '何かの処理
    .DisplayAlerts = True
End With

コピーアンドペースト

Dim wbk As Workbook
Dim fromWs As WorkSheet
Dim toWs As WorkSheet

Set wbk = ThisWorkbook
Set fromWs = wbk.Worksheets("コピー元のシート名") 
Set toWs = wbk.Worksheets("ペースト先のシート名") 

fromWs.Activate '必要かどうかは確認
fromWs.Range("A2:D2).Copy
toWs.Activate
toWs.Range("A1:D9").PasteSpecial Paste:=xlPasteAll 'Paste:=XXXXX　ペースト方法の指定

リンクの更新をせずにブックを開く

Workbooks.Open targetBookName, UpdateLinks:=False
Set targetBook = ActiveWorkBook

エラーが出てもとりあえず進める（無視）

On Error Resume Next

'エラーが出そうな処理
Workbooks.Open targetBookName, UpdateLinks:=False

If Err.Number <> 0 Then
    MsgBox("エラーが発生しました。")
End If

あるフォルダにあるすべてのファイルに関して処理する

配列を使った値のコピー

Dim myArray

myArray = ws1.Range("A1:Z100")
ws2.Range("A1:Z100") = myArray

'プログラムで汎用的に使うならこの形式
myArray = ws1.Range(ws1.Cells(1,1),ws1.Cells(26,100))
ws2.Range(ws2.Cells(1,1),ws2.Cells(26,100)) = myArray

-プログラミング
-, , ,