ExcelVBA メモ

セル値・配列の一括入力・出力

出力
https://daitaideit.com/vba-array-resize/

入力

Dim aryTmp As Variant
Dim ary1 As Variant
Dim lastRow As Long

lastRow = ws01Input.Cells(Rows.Count, 1).End(xlUp).Row
aryTmp = ws01Input.Range(ws01Input.Cells(2, 1), ws01Input.Cells(lastRow, 1)).Value  
    
'2次元配列→1次元配列へ変換  
'...aryTmp(1,1) , aryTmp(2,1) のように2次元配列として入ってしまうので
'   transposeで1次元配列 aryInType(1), aryInType(2)に置き換えする
'
 ary1 = WorksheetFunction.Transpose(aryTmp)
    

シートの存在確認

関数名　func_sheetExist
引数
in_wb workbook型
in_wsname string型
返り値　integer型
　指定された in_wsname のシートが存在するか
　存在する場合　返り値=1　　存在しない場合 0

方法A
Function func_sheetExist(in_wb As Workbook, in_wsname As String) As Integer
    Dim res As Integer
    res = 0
    
    Dim ws As Worksheet

    On Error Resume Next
    Set ws = Worksheets(in_wsname)
    On Error GoTo 0
        
    If Not ws Is Nothing Then
        res = 1
    End If
    
    func_sheetExist = res
End Function

方法B
Function func_sheetExist(in_wb As Workbook, in_wsname As String) As Integer
    Dim ws As Worksheet
    Dim exists As Integer
    exists = 0
    
    For Each ws In in_wb.Worksheets
        If ws.Name = in_wsname Then
            exists = 1
            Exit For
        End If
    Next ws

    func_sheetExist = exists
End Function

オートフィルターで3項目以上のフィルターを掛ける (～を含む）

Sub sub_filterTest()


Dim ccArray(2) As String

ccArray(0) = "A"
ccArray(1) = "B"
ccArray(2) = "C"

Sheet1.Range("A1:C12").AutoFilter field:=2, Criteria1:=ccArray, Operator:=xlFilterValues

オートフィルターで3項目以上のフィルターを掛ける (～から始まる）

フィルターで3項目以上のあいまい検索できないため、事前にループで検索し完全セル値でフィルタする

Sub sub_filterTest2()

Dim aryTmp As Variant
Dim ary1 As Variant

Dim aryS1 As Variant
ReDim aryS1(1)

Dim aryS2 As Variant
Dim lastRow As Long
Dim tmpVal As Variant

Dim ws As Worksheet
Set ws = ActiveSheet

Dim cnt As Long
Dim i As Long


If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

ReDim aryS1(1 To 3)
aryS1(1) = "A*"
aryS1(2) = "B*"
aryS1(3) = "C*"

'フィルターで3項目以上のあいまい検索できないため、ループで検索し完全セル値でフィルタする
ReDim aryS2(0 To 1)
cnt = 0
For i = 1 To lastRow
    tmpVal = Cells(i, 2)
    If tmpVal Like aryS1(1) Or tmpVal Like aryS1(2) Or tmpVal Like aryS1(3) Then
        ReDim Preserve aryS2(cnt)
        aryS2(cnt) = tmpVal
        cnt = cnt + 1
    End If
    
Next

Sheet1.Range("A1:C15").AutoFilter field:=2, Criteria1:=aryS2, Operator:=xlFilterValues

MsgBox "完了しました"


End Sub