ホーム
Excel VBA スニペット

Excel VBA スニペット

2019.07.06
a

シート操作の「並べ替え」 

’並べ替え 
Range("セル範囲").Sort _
　　　　Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes

Range.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)

Key1:最初の並べ替えフィールドを範囲名 (文字列) またはRangeオブジェクトで指定
Order1:xlAscending (昇順・既定値) / xlDescending (降順)
Header:xlNo (見出しなし・既定値) / xlYes (見出しあり)

前の設定（ワークシートで手作業でやった並べ替えのオプションも含む）が引き継がれるオプション
MatchCase/Orientation/SortMethodなど

a

重複データの削除 

' 重複データの削除 指定列 1列名
  Range("セル範囲").RemoveDuplicates Columns:=1, Header:=xlNo
  
' 重複データの削除 指定列 複数
  Range("セル範囲").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo

Columns:重複をチェックする列の指定
Array 関数を使用して複数の列を指定(組み合わせで重複をチェック)

重複の判定は指定した列での完全一致

Header:ヘッダーがある場合、xlYes、ヘッダーがない場合、xlNoを指定

a

最後の「_」より後の文字を取り出す 

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'★ 最後の「_」より後の文字を取り出す
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Function zfSliceRearStrRevUs(ByVal tStr As String) As String
    zfSliceRearStrRevUs = Mid(tStr, InStrRev(tStr, "_") + 1)
End Function
a

最初の「_」より後ろの文字列を取り出す 

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'★ 最初の「_」より後ろの文字列を取り出す
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Function zfSliceRearStrUs(ByVal tStr As String) As String
    zfSliceRearStrUs = Mid(tStr, InStr(tStr, "_") + 1)
End Function

a

ファイルパス・ファイル名から拡張子のみを取り出す 

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'★ ファイルパス・ファイル名から拡張子のみを取り出す
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Function zfSliceFileNameExt(ByVal fName As String) As String
    zfSliceFileNameExt = Mid(fName, InStrRev(fName, ".") + 1)
End Function

a

ファイル名から拡張子なしのファイル名の取り出す 

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'★ ファイル名から拡張子なしのファイル名の取り出す
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Function zfSliceFileNameNoExt(ByVal fName As String) As String
    Dim extName As String
    extName = Mid(fName, InStrRev(fName, "."))
    zfSliceFileNameNoExt = Replace(fName, extName, "")
End Function
a

ファイルパスからファイル名(拡張子あり)を取り出す 

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'★ ファイルパスからファイル名(拡張子あり)を取り出す
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Function zfSliceFileName(ByVal filePath As String) As String
    zfSliceFileName = Mid(filePath, InStrRev(filePath, "\") + 1)
End Function

a

全角半角のスペースを取り除く 

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'★ 全角半角のスペースを取り除く
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Function zfDeleteSpace(ByVal tStr As String) As String
    Dim resStr As String
    resStr = Replace(tStr, " ", "")
    resStr = Replace(resStr, "　", "")
    zfDeleteSpace = resStr
End Function

a

イベント発生の抑制 

'新たなイベント発生の抑制------
Application.EnableEvents = False

'元に戻す------
Application.EnableEvents = True
a

計算方法の設定 

'手動計算
Application.Calculation = xlCalculationManual

'再計算の実行
Application.Calculate 

'自動計算
Application.Calculation = xlCalculationAutomatic
a

処理時間の計測 

'計測開始
    Dim myspeed As Double
    Dim starttime As Double
    starttime = Timer
'---------------------------

'計測終了
   myspeed = Timer - starttime
   Debug.Print "処理時間：" & myspeed & "秒"
'---------------------------

a

ファイルオブジェクト生成 

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
a

ブックを保存 

'上書き保存
Workbooks("Dummy.xlsx").Close SaveChanges:=True

'保存せずに保存
Workbooks("Dummy.xlsx").Close SaveChanges:=False
a

ブックを開く 

'指定したブックを開く(ドライブ名・・・拡張子)
Workbooks.Open Filename:="C:\・・・\test.xlsx"

'指定したブックを開き、オブジェクト指定
Dim wb as As Workbook
Set wb1 = Workbooks.Open(Filename:="C:\・・・\test.xlsx")

a

データの最終行を取得 

'最終行を取得する(A列を基準)
dim cnt as long
cnt = Cells(Rows.Count, 1).End(xlUp).Row
又は
cnt = Cells(Rows.Count, "A").End(xlUp).Row
a

警告メッセージの停止 

'警告メッセージの停止
Application.DisplayAlerts = False

'警告メッセージを通常表示
Application.DisplayAlerts = True
a

処理を待たせる 

'1秒間処理を中断する
Application.Wait Now + TimeValue("00:00:1")
a

画面描画の停止 

Application.ScreenUpdating = False
Application.ScreenUpdating = True