プログラミンGOO

プログラミングナレッジ、ワードプレス、広告収入等について、気づき・備忘録を残していきます。

VBA備忘録

【セル・行の操作】

■コピーペースト コピペ
★PasteSpecialのオプションであるxlPasteAllは処理速度が非常に遅い。値のみであればxlPasteValuesを使用する。
セルをコピーペースト

Range("A1:B2").Copy
Range("A3").PasteSpecial  'PasteSpecialは書式を保持する

※値の貼り付けの場合
Range("A3") = Range("A1:B2")

Sub copyPaste(fromWs, fromRow, fromCol, roWs, toRow, toCol)

  fromWs.Ceells(fromRow, fromCol).copyPaste
  toWs.Cells(toRow, toCol).PasteSpecial
End Sub

・行をコピーペースト

ws.Rows(2).Copy '2行目をコピー
Rows(3).PasteSpecial(xlPasteAll)  '3行目に貼り付け 書式アリ

■Cells、Rangeの変換、書き換え
Range→Cells

Cells(ws.Range("A1").Row, ws.Range("A1").Column)

Cells→Range

Cells(1, 1).Address  '"$A$1"
Cells(1, 1).Address(False, False)  '"A1"

■行を挿入

ws.Rows(2).Insert  '2行目に行を挿入

■最終列を取得
※空白もスキップして最終を取得する場合
Excel自体の最終列からCtrl+←で最終列を取得する

ws.Cells(y, Columns.Count).End(xlToLeft).Column  '最終列
ws.Cells(Rows.Count, x).End(xlUp).Row  '最終行

※空白までを取得する場合
特定のセルからCtrl+→で最終列を取得する

ws.Cells(y, x).End(xlToRight).Column  '最終列
ws.Cells(y, x).End(xlDown).Row  '最終行

■セルの検索

Dim r As range
Set r = ActiveSheet.range("B:B").Find(What:="出力先フォルダを選択:")

・特定文字列を持つセル

Cells.Find("str")

■セルの結合

Range("A1:B2").Merge

・セルから結合エリアを取得

Dim mergeRange As Range
mergeRange = Cells(1,1).MergeArea
  'セルA1がいずれかのセルと結合されていた場合に範囲をRangeオブジェクトで返す

・結合エリアの行数

mergeRange.Rows.Count

■特定行以下のセルをすべて消去・削除

'削除
Sub DeleteRowsBelow()
  Worksheets("Sheet1").Rows(5 & ":" & Worksheets("Sheet1").Rows.Count).Delete
End Sub

■重複削除

shError.Range("A:A").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes

※1行目にヘッダーが存在しないばあはHeader:=xlNo
※1行しかない場合エラーになる可能性

■オートフィル

With Range("A1")
  .Value = "1月"
  AutoFill Destination:=Range("A1:A12")
End With

★行数をコントロールするためにデフォルトを1行のみにすると関数やグラフに不具合が出ることがある。
2行残すとエラーが起こりづらい。

■フィルターの設定

Range("A1:C6").AutoFilter 1, "*.png"  '末尾が『.png』で終わるもの

※これはExcel自体のフィルター機能を利用している。
その性質上複数条件を設定するのは向いていない。

・解除

Range("A1:C6").AutoFilter  '引数なしで使うと解除

■演算子

And
Or
Not

=
<>
<=, >=

■型判定、型チェック

VarType(val)

結果は~型、ではなく数値で返される。対応は以下の通り

Integer	2
Double	5
String	8
Boolean	11
Date	7
Object	9
Variant	0

■型変換
文字列変換

CStr(val)

同じように日付に変換したいならCDate(val)のように各種対応している

■日付の取得
Date で年月日
Now で日時
・フォーマットの設定

format(Date, "yyyy年mm月")

■日付の差分をとる

DateDiff("d", startDate, endDate)

※"d"で日単位の差分をとる
※差分のため、1/1~1/2を指定すると戻り値は2ではなく1となることに注意

【シート・ワークブック操作】

■ブックを選択

Dim wb As Workbook
Set wb = ActiveWorkbook

■指定のExcelのパスを調べる

ThisWorkbook.Path

■カレントディレクトリを調べる

CurDir

■シートの作成

Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "田中"

■シートのコピー

Worksheets("Sheet2").Copy After:=AcriveWorkbooks("Book2").Worksheets("Sheet1")

■シートを選択
・シート名で選択

Dim sh As WorkSheet
Set sh = wb.Sheets("sheetName")

・インデックスで選択

Dim sh As WorkSheet
Set sh = wb.Sheets(1)

■シートのデータを消去・削除

sheet.cells.clear  '消去
sheet.cells.delete  '削除

【ファイル操作】

■Excelブックを開く
・ダイアログを開いてファイルを選択させる

Dim openFile As String
openFile = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
If OpenFile <> "False" Then
    Workbooks.Open OpenFile
Else
    MsgBox "キャンセル"
End If

■複数のExcel選択を許可する場合

Dim openFiles As String
openFiles = Application.GetOpenFilename("Microsoft Excelブック,*.xls?", MultiSelect:=True)
'キャンセル選択時
If VarType(openFiles) = 11 Then
  If OpenFiles = False Then
    MsgBox "キャンセル"
    Exit Sub
  End If
End If

'全ファイルループ
For i = To UBound(openFiles)

  Debug.Print(filePaths(i))
End If

・指定のパスのエクセルを開く

Dim wb as Workbook
Dim filepath as String  'ファイルパス
Set wb = Workvooks.Open(Filename:=filepath)

・複数 ダイアログを開きフォルダを選択させる>フォルダ内の複数ファイル処理

With Application.FileDialog(msoFilleDialogFolderPicker)
  If .Show = True Then
    folderPath = .SelectedItems(1)
  'キャンセル選択時
  Else
    Exit Sub
  End If
End With

'全ファイルループ ~FileSystemObjectを使用する場合~
Dim files As Object
Set filse = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).files

For Each file in files
  '処理
  Debug.Print(folderPath + file.Name)
Next file

'全ファイルループ ~Dir関数を使用する場合~
'Dir関数:該当するパスが存在する限りファイル名を返し続ける
Dim filePath, fileName As String
fileName = Dir(folderPath + "/*")

Do While fileName <> "" 'ファイル名が出てこなくなるまでループ
    '処理
    filePath = folderPath + "/" + fileName
    Debug.Print(filePath)
    fileName = Dir()  '引数なしでDir関数を実行すると次のパスに切り替わる
Loop

※Dir関数はネストできないというデメリットがある。
一方で、FileSystemObjectは型がオブジェクトになるため少し癖がある。

■パスワードがかかっていたら解除
VBAでは、ファイルを開くタイミングでパスワードがかかっているかを判定することができない。
※すでに開いてあるbookがパスワード付きであるかは判別できるが、これでは意味がない。

そのため、以下の方法が考えられる。
1. 先にパスワードを設定して開く ※パスワードがかかっていないExcelにこの処理を施してもエラーにはならない
2. まず読み込んだExcelのうち、どのExcelがパスワード付きかを一通り判別(Open時エラーになるかで判別)し、あらためて解除を行う。

2では2重処理となるので1の方法を取る。

■ファイルの保存

・上書き保存

wb.Save

・名前をつけて保存

book.SaveAs Filename:="C:/~~~/sample.xls"

・警告メッセージの停止
『変更内容を保存しますか?』などを表示させない

Application.DisplayAlerts = False '警告文停止
wb.Save
wb.Close
Application.DisplayAlerts = True  '警告文再開

※拡張子を表示しない設定になっているときはWorkbooks("Book1").Save としないといけない。
極力別の方法でWorkbookを事前に設定しておく。
以下のようにオプションで指定する方法もあるよう

wb.Close SaveChanges:=True  '保存して閉じる
wb.Close SaveChanges:=False  '保存しないで閉じる

■ThisWorkbook以外を閉じる

Sub closeWb()
  Dim bk As Workbook
  For Each bk In Workbooks
    If Not (bk Is ThisWorkbook) Then
      bk.Close SaveChanges:=False
    End If
  Next
End Sub

■ファイルパスからファイル名を取得

Function getFileName(filePath)
  getFileName = Dir(filePath)
End Function

■ファイルパスをセット

Public Sub setFilePath(toRow, toCol)

  Dim filePath As Variant
  filePath = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls?", MultiSelect:=False)

  'キャンセル選択時
  If filePath = False Then
    Exit Sub
  End If

  Cells(toRow, toCol) = filePaths
EndSub

■フォルダパスをセット

Public Sub setFolderPath(toRow, toCol)
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False

    'キャンセル選択時
    If .Show = 0 Then
      Exit Sub
    Else
      Clees(toRow, toCol) = SelectedItems(1)
    End If
  End With
End Sub

■フォルダ内のすべてのExcelに処理を行う

resourceFolderPath = shView.Range(CELL_RESOURCE_FOLDERPATH)
fileName = Dir(resourceFolderPath + "\*.xls?")

Do While fileName <> ""
  Workvooks.Open resourceFolderPath + "\" + fileName
  AcriveWorkbook.Close
  fileName = Dir()  '引数なしでDir関数を実行すると次の値に処理が移行する
Loop

【関数】

■For文

For i = 1 To 3
    ' 処理
Next i

■for文を抜ける

Exit For

■For Each
For Each I In arr
'処理
Next

■配列のUBoundがあるかどうか
配列の長さを取得するUBoundは、配列に値が存在しない場合、エラーになる。
そのため、事前に配列が初期化されているかチェックを行う必要がある。

'配列が初期化前であるか判定する
Function isEmptyArray(s() As String) As Boolean
  If (Not s) = -1 Then
    isEmptyArray = True
  Else
    isEmptyArray = (UBound(s) = 0 And s(0) = "")
  End If
End Function

■処理をすべて修了

End
関数のみを修了
exit function
exit sub

■文字列操作
・分割

Split(元の文字列 , 区切り文字)

【例外処理】

■基本的な仕様

On Error GoTo Label 'エラー検知をONにする。これ以降、もしエラーが発生したらLabelにジャンプ
~method~  'エラーが起きるかもしれない処理
On Error GoTo 0 'エラー検知をOFFにする

Label:  'エラーが起きたら強制的にこの位置にジャンプ
  ~method~  'エラーが発生した場合の処理
  Resume NextStep '次にNextStepへジャンプ。Resumeするとエラーは空になる

※問題点として、エラーが起きなかった場合もLabel無いの処理は実行される。これをどのように回避するか

■基本実装
・エラー処理を完全に分離する。

~通常処理~
Exit Sub

ErrorLabel
  ~method~  'エラーが発生した場合の処理

End Sub

※※※悪い例
ErrorLabel:
If Err.Number <> 0 Then
  ~method~  'エラーが発生した場合の処理
  Resume ErrorNext
End If

'Err.Numberの有無で処理するか否かを判定する方法がネットでは良く見つかる。
しかしこれでは意図したものとは異なる部分でエラーが走った場合にもこの部分の処理が走ってしまう。

そのため上記の実装となるが、これでもまだ課題がある。
開いていたファイルを閉じたいなど、通常時・エラー時ともに最後に行いたい共通処理がある場合に実装できない。
その場合は以下のようにする。

■推奨の実装

~通常処理~
On Error GoTo Label
~method~  'エラーが起きるかもしれない処理
On Error GoTo 0

~通常処理~

GoTo Finally  ’Finallyに飛ぶため、以下の処理は通常時は実行されない

'エラー時のメソッドを記述するスペース............................................................

ErrorLabel:
  ~method~  'エラーが発生した場合の処理
  Resume ErrorNext

'エラー時のメソッドを記述するスペースここまで............................................................

Finally
~エラー時、通常時ともに実行したい場合の処理~

End Sub

【グラフ】

■グラフ名を調べる
・方法1
グラフを選択>Excel左上のプルダウンにグラフ名が表示される
・方法2
検索と選択>オブジェクトの選択と表示

■グラフにアクセス

Dim chartObj As ChartObject
Set chartObj = stDAILY.ChartObjects(1)

■グラフの系列にアクセス
参考:
Office TANAKA - Excel VBA Tips[グラフの参照範囲を変更する]

・系列はSeriesCollectionというオブジェクトで格納されている
Formula関数を使うとSeriesCollectionの値を取得できる

=SERIES(シート名!ヘッダーセル, シート名!縦軸データ範囲, シート名!横軸データ範囲, プロット順)

※プロット順とはグラフにデータが描画される順番

・以下で試しに表示できる

Dim msg As String, i As long
With ActiveSheet.ChartObjects(1).Chart
  For i = 1 To .SeriesCollection.Count
    msg = msg & .SeriesCollection(i).Formula & vbCrLf
  Next i
End With
MsgBox msg

【画像の比較】

バイナリファイルに変換して比較する
参考:
VBAで2つの画像ファイルを比較して内容が同一かどうかを判定する方法 - t-hom’s diary

~バイナリファイルを返す関数~
※ファイル名は違うが画像自体は同じ『bbb.png』と『ccc.png』がある場合

Dim pass1, pass2 As string
pass1 = "C/aaa/bbb.png"
pass2 = "C/bbb/bbb.png"

Debug.Print(ReadBmpAsString(pass1) = ReadBmpAsString(pass2))  'True

Function ReadBmpAsString(file_name As String) As String
  Dim bmp() As Bute
  Open file_name For Binary As #1
    ReDim bmp(LOF(1))
    Get #1, , bmp
  Close #1
  ReadBmpAsString = bmp
End Function

【モジュール】

関数単位からエクスポートが可能
■エクスポート
モジュールをみぎっクリック>ファイルをエクスポート
標準モジュール: .bas形式で保存される
クラスモジュール: .cls形式で保存される

■インポート
ファイル>ファイルのインポート

■クラスモジュールの使用
・main関数の宣言ブロックでクラスをインスタンス化して使用する

Private ins As New moduleName
Sub main()
  ins.method
End Sub

・モジュール内でインスタンス化して使用する

Sub main()
  Dim ins As Class1
  Set ins = New Class1

  ins.method
End Sub

・引数を渡す

  ins.method arg1, arg2  'カッコなどでくくらず、半角スペースの後に引数を記載する

【appendics】

■処理高速化
実際にファイルを開く挙動などをUIに反映させずに行う設定をすることで処理を高速化する

'高速化開始
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'高速化終了
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

■背景色色付け

Range("B2").Interior.ColorIndex = 3     ''色パレットの3番を設定します 黄色:6、赤:3
Range("B3").Interior.Color = RGB(0, 0, 255)  ''青色に設定します

背景色ではなく文字に色付けしたい場合はInteriorではなくFontを指定する

■ソート
※配列をソートするのではなくExcel自体の機能であるソートを起動する

With ws.Sort
  .SortFields.Clear 'ソートをリセット
  .SortFields.Add Key:=Cells(y, x) 'キー(ヘッダー)となるセルを指定
  .SetRange Range("A1:B3")
  .HEADER = xlYes 'ヘッダー行が無い場合はxlNo'
  .Apply
End With

■スクロールトップ
処理終了時に最初のワークシートの一番上に表示を合わせておきたい場合など

ws.Activate  '対象のワークシートをアクティブにする
ws.Cells(1, 1).Select  'ついでにセルA1を選択
ActiveWindow.ScrollRow = 1

■カラムセット

'ヘッダー行に特定の文字列が見つかったらその列番号を返す。無ければ0
Function searchCol(ws, headerRow, colName, colEnd)

For i = 1 To colEnd
  If Rplace(ws.Cells(headerRow, i), vbLf, "") = colName Then
    searchCol = i
    Exit Function
  End If
Next i

searchCol = 0

End Function

■マクロ実行時に引数を渡す
図形などにマクロの登録をする際、マクロに引数を渡したい場合がある。
引数を渡すにはマクロ登録で以下のように関数名、引数を半角スペースをあけて私、マクロの個所をシングルクォーテーションで囲う

const HIKISU = "hikisu" がモジュール内で定義してある場合
●●.xlsm!'sheetReset HIKISU'

そのまま文字列を渡す場合
●●.xlsm!'sheetReset "hikisu"'

どちらでも可

複数渡す場合

●●.xlsm!'sheetReset "hikisuA", "hikisuB"'

■オブジェクト名の変更
各シートにはオブジェクト名が設定されており、その名前で呼び出せる。
このオブジェクト名を変更するにはVBProjectという本体のオブジェクトにアクセスしなければならない。

初期設定ではVBProject自体へのアクセスが禁止されているのでまずはExcelの設定から。
ファイル>その他>オプション>トラストセンター>トラストセンターの設定
VBAプロジェクトオブジェクトモデルへのアクセスを信頼する:True

・実装

Sheets.Add after:=sheets("Sheet1")  'シート追加
ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).Name = "stForWork"

■他のExcelにあるVBAを実行する
・同じ改装にあるExcelのVBAを起動

Application.Run("sample.xlsm!main")

・パス指定する場合は、パスの部分をシングルクォーテーションで囲う

Application.Run("'C:\パス\sample.xlsm'!main")

・変数で指定(相対パス)

Dim path As String
path = ThisWorkbook.path
Application.Run("'" + path + "'" + "!main")

■空白セルを詰める
>重複削除で実現できる

■vbaでしか可視化できないシートを作る
プロパティウィンドウ>Visible>Veryhidden

■メッセージボックスに値を入力させたい
formで作れる

■勝手に折り返しになるのを防ぐ
改行とかが入ると勝手に折り返し表示になる。

shError.Range("A:A").WrapText = False

■ValueとText
Valueはデフォルト。つまり以下は同じ。

Debug.Print(ws.Range("A1"))
Debug.Print(ws.Range("A1").Value)

一方、Textは書式を適用して値を取得する。
A1セルのValueが2021/18/1で、書式で2021年1月1日と表記されている場合は以下になる。

Debug.Print(ws.Range("A1").Value)  '2021/1/1
Debug.Print(ws.Range("A1").Text)  '2021年1月1日

Textはif文などでエラーの温床となるためできるだけ使用しない。

■改行コード
VBAの改行コードはVbLf…のはず

■空白・改行コード削除

Function replaceSpaceBreak(val)
  val = Replace(val, vbLf, "")
  val = Replace(val, vbCr, "")
  val = Replace(val, vbCrLf, "")
  val = Replace(val, " ", "")
  val = Replace(val, " ", "")
  replaceSpaceBreak = val
End Function

■命名規則
変数:ロワーキャメルケース(sampleVal)
グローバル変数:アッパーキャメルケース(SampleVal)
仮引数:スネークケース ※すべて小文字(sample_val)
定数:スネークケース ※すべて大文字(SAMPLE_VAL)
関数・クラス名:アッパーキャメルケース(SampleVal)

■複数の変数の同時宣言はしないこと!
参考:Excel VBAコーディング ガイドライン案 - Qiita

Dim a, b As String

bはString型になるが、aはVariant型になってしまう!

■参照渡しと値渡し
参考:Excel VBAコーディング ガイドライン案 - Qiita

Dim arg As Long
SampleSub arg '参照渡しになる
SampleSub(arg) '値渡しになる
Call SampleSub(arg) '参照渡しになる
SampleSub((arg)) '値渡しになる
Sub SampleSub(ByRef arg) '参照渡しになる
SampleSub(ByVal arg) '値渡しになる

■データバー
Excel VBA データバーを表示する条件付き書式設定する
ただ、これだけだと最小値のときにデータバーの長さが0となる。※最小値が0でなくても
本来はデータの値が0のときにデータバーの長さを0としたい。

>対処法

With ws
  Set dataBar = .Range(.Cells(rowStart< i), .Cells(rowEnd, i))
End with
dataBar.FormatConditions(1).MinPoint.Modify newtype:=xlConditionValueAutomaticMin

参考:
【VBA】データバー表示と削除、コピー元範囲指定を解除する | 自恃ろぐ-jizilog.com-

■VBAテストツール
RubberDuck アドインとして導入できる
参考:
・機能について
VBA開発環境をモダンにする - RubberduckとVBEThemeColorEditorの紹介 - Qiita
・テスト実装
vbaにはユニットテストや - Google 検索

VB Lite Unitもよさそう

【エラー対応ログ】

■Range(Cells(y, x), Cells(y, x) ができない
Cellsにもワークシートを指定する必要がある

■if文の中でEnd FunctionするとEnd Ifがありませんエラー
Endではなく Exit Function

■Range().clearで結合セルだとエラー
clearではなくRange().vallue="" とする

■If n = Null が機能しない

If IsNull(var) Then

というか空白セルの判定の場合は

If IsEmpty(var) then

■Selectしようとしたらエラー
対象のworksheetがアクティブになっていないとエラーになる

ws.activate  'アクティブにする
ws.Cells(1, 1).Select

■SubまたはFunctionの属性が適切ではありません
属性とはPrivateとかPublicとかのこと。これの付け方が間違っている。
例えばPrivate属性はプロシージャ内では指定ができずエラーになる。

Sub sample()
  Private a as Variant  'エラー
End Sub

■Typeブロック外では無効なステートメントです
ステートメントとは宣言のこと。宣言が変だよと言われている。
・エラー

Sub main()
  ins As New Class1  'エラー
End Sub

・正しくは

Sub main()
  Dim ins As Cass1
  Set ins = New Class1
End Sub

【検索ワード】

★vba 開始日 終了日 日数
安全ではない可能性のある外部ソースへのリンク
セルから日付を取得する方法
オブジェクト名 設定
vba エスケープが必要な文字:『"』だけ?
★重複削除 1行のみ エラー
★Range.Sort

【仕上げ】

マクロにパスワードをかける
高速化
関数名に説明が記載されている
印刷設定
グリッド線を消す
表示:改ページプレビュー
フォントサイズ:タイトル>見出し1>見出し2のように整合性をもたせる
倍率:100%にする

【VBAのイけてないところ】

・配列でutilメソッドが少なすぎる。値が配列に存在するか否かすら判定できない
・『/』あり形式のDateをformatでyyyymmとか指定すると日付がバグる
・RangeとCellsの変換が手間すぎる