Excel VBA Snippet

自分用メモ

シート全体で文字列検索したいとき

Sub FindString()
    
    Dim rng As Range
    Dim firstAddress As String
    Dim findstr As String
    findstr = "_COMMON_HEADER_"
    
    Set rng = Cells.Find(findstr)
    If Not rng Is Nothing Then
        firstAddress = rng.Address
        Do
            'want do it
            Debug.Print rng.Address
            
            Set rng = Cells.FindNext(rng)
            'First break
            If firstAddress = rng.Address Then
                Exit Do
            End If
        Loop While Not rng Is Nothing
    End If
End Sub

Sub func01()
    MsgBox "Hello World"
End Sub

Sub func02()
    Debug.Print "Hello World"
End Sub

Sub func03()
    ActiveCell.Clear
End Sub

Sub func04()
    'Range#1
    Range("A1").Value = "Hello VBA"

    'Range#2
    Range("A1:B2").Value = #6/5/2023#

    'Cells
    Cells(2, 1).Value = 1000

    'ClearContents method
    Range("B2").ClearContents
End Sub

Sub func05()
    Debug.Print Range("A1").Width
    Range("B1").Delete
End Sub

Sub func06()

'Literal Variables
Dim i As Long
i = 100
i = i * 5
Debug.Print "i = ", i
'Object Variables
Dim rng As Range
Set rng = Range("A1:C3")
rng.Value = "XXX"

end sub

Loop

Sub loop01()

Dim i As Integer
For i = 1 To 5
    Debug.Print i
Next

Dim rng As Range
For Each rng In Range("A1:B4")
    Debug.Print rng.Value
Next

End Sub

Sub func07()
    Range("A1:C1").Value = Array(1, 2, 3)
    Range("A2:C3").Value = [{4,5,6;7,8,9}]

    With Range("B2:F6").Font
        .Size = 12
        .Name = "Meiryo"
    End With
End Sub

3×3テスト

Sub CellTest()
    
    '3x3
    Set rg = Range("A1:C3")
    
    Dim i As Integer

    For i = 1 To rg.Rows.Count
        For j = 1 To rg.Columns.Count
            Cells(i, j).Select   
            Debug.Print "(" & i & ", " & j & ")" & "を選択しました。"
            Sleep 1000
        Next
    Next
End Sub

こっちの方がいい(Range.item)

Sub CellTest()
    
    '3x3
    Set rg = Range("B1:D3")
    
    Dim i As Integer
    
    For i = 1 To rg.Rows.Count
        For j = 1 To rg.Columns.Count
            rg.Item(i, j).Select
            
            Debug.Print "(" & i & ", " & j & ")" & "を選択しました。"
            Sleep 1000
            
        Next
    Next

End Sub

Cells, Ranges

Cells(行, 列)

全 Sheets Zoom 100%

Excel納品用に

Sub ChangeZoom()
    Dim ws As Worksheet
    
    ' ブックの全シートを 1 つずつループして処理する
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print ws.Name & "を処理します"
        
        ws.Select
        ActiveWindow.Zoom = 100
    Next
End Sub

xxx

Function ExtractValuesWithUnderscore() As String
    Dim ws As Worksheet
    Dim cell As Range
    Dim result As String
    
    ' 対象のシートを設定（適切なシート名に変更してください）
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' B列の各セルを順番に調べる
    For Each cell In ws.Range("B1:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
        ' セルの値が"_"から始まる場合
        If Left(cell.Value, 1) = "_" Then
            ' 結果に値とアドレスを追加
            result = result & "Value: " & cell.Value & ", Address: " & cell.Address & vbCrLf
        End If
    Next cell
    
    ' 結果を返す
    ExtractValuesWithUnderscore = result
End Function