pgbigorokuのブログ

プログラムの再利用できそうなコードをアップ

EXCEL VBA マクロを組むとき列番号の把握をしやすいよう、シートの１行目に列番号を記入する

マクロを組むとき列番号の把握をしやすいよう、シートの１行目に列番号を記入します。
既に値が入ったセルには書き込みません。

Public Sub test()
    Call nisub列番号を1行目に挿入
End Sub



'
'　1行目に列番号を入れる。
'https://pgbigoroku.hatenablog.com/entry/2022/08/24/154418
'2022/8/15
Public Sub nisub列番号を1行目に挿入(Optional ByVal pint最終列 As Integer = 100)
    Dim intCol As Integer
    For intCol = 1 To pint最終列
        If Cells(1, intCol) = "" Then
            Cells(1, intCol) = "=COLUMN()"
        End If
    Next
End Sub

EXCEL VBA クリップボードからセルにPaste時に「実行時エラー1004：この操作は結合したセルには行えません。」を回避する

F12を押した場所に貼り付けます。

    Application.OnKey "{F12}", "subFromClipbord"


'
'   クリップボードからセルにPaste時に「実行時エラー1004：この操作は結合したセルには行えません。」を回避する
'https://pgbigoroku.hatenablog.com/entry/2022/08/23/171554
'2022/8/21
Public Sub subFromClipbord()
    Dim wkbNow As Workbook
    Dim wksNow As Worksheet
    Dim wkbNew As Workbook
    Dim strFromClipboard As String
    Dim strMageArea As String
    Dim strMageArea1つめのセル As String
    If nirngSelectionの1つ目のセル.MergeCells = True Then
        '結合されている場合
        Set wkbNow = ActiveWorkbook
        Set wksNow = ActiveSheet
        
        '現状の情報を保持
        strMageArea = Selection.Address
        strMageArea1つめのセル = nirngSelectionの1つ目のセル.Address
        Set wkbNew = Workbooks.Add()
        ActiveSheet.Paste
        strFromClipboard = wkbNew.Worksheets(1).Cells(1, 1)
        Range("A1").Delete
                
        'コピー先シートから、テンポラリシートへコピー（フォント等維持のため）
        wkbNow.Activate
        Selection.Copy
        wkbNew.Activate
        Range(strMageArea).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        
        'いったん結合を外してコピー
        Selection.UnMerge
        wkbNew.Worksheets(1).Range(strMageArea1つめのセル) = strFromClipboard
        Range(strMageArea).Merge
        
        
        '貼り付け
        Range(strMageArea).Copy wksNow.Range(strMageArea)
        wkbNew.Close (False)
    Else
            ActiveSheet.Paste

    End If
End Sub

EXCEL VBA 選択したセルすべてが結合セルの１つの場合 

            If nirngSelectionの1つ目のセル.MergeArea.Address = Selection.Address Then
                      '選択したセルすべてが結合セルの１つの場合
           End If

' Selectionの1つ目のセル
' https://blog.hatena.ne.jp/nakairo/pgbigoroku.hatenablog.com/edit
' 2021/8/21
Public Function nirngSelectionの1つ目のセル() As Range
    Dim strSelection As String
    strSelection = Selection.Address
    strSelection = nistr文字列検索をして1つ目の区切り位置までの値を取得(strSelection, ",")
    strSelection = nistr文字列検索をして1つ目の区切り位置までの値を取得(strSelection, ":")
    Set nirngSelectionの1つ目のセル = Range(strSelection)
End Function

' 文字列検索をして1つ目の区切り位置までの値を取得
'https://pgbigoroku.hatenablog.com/entry/2022/08/23/161312
' 2021/8/21
Public Function nistr文字列検索をして1つ目の区切り位置までの値を取得(ByVal pstrTarget As String, ByVal pstrDivide As String)
    Dim intInstr As Integer
    intInstr = InStr(pstrTarget, pstrDivide)
    If intInstr = 0 Then
        nistr文字列検索をして1つ目の区切り位置までの値を取得 = pstrTarget
    Else
        nistr文字列検索をして1つ目の区切り位置までの値を取得 = Left(pstrTarget, intInstr - 1)
    
    End If
End Function

EXCEL VBA 文字列検索をして1つ目の区切り位置までの値を取得 

    Debug.print=nistr文字列検索をして1つ目の区切り位置までの値を取得(strSelection, ",")

' 文字列検索をして1つ目の区切り位置までの値を取得
'https://pgbigoroku.hatenablog.com/entry/2022/08/23/161312
' 2021/8/21
Public Function nistr文字列検索をして1つ目の区切り位置までの値を取得(ByVal pstrTarget As String, ByVal pstrDivide As String)
    Dim intInstr As Integer
    intInstr = InStr(pstrTarget, pstrDivide)
    If intInstr = 0 Then
        nistr文字列検索をして1つ目の区切り位置までの値を取得 = pstrTarget
    Else
        nistr文字列検索をして1つ目の区切り位置までの値を取得 = Left(pstrTarget, intInstr - 1)
    
    End If
End Function

EXCEL VBA 全シートのオートフィルタ―の絞り込みを辞める

オートフィルターにデータが隠れていて、再度確認した事ないですか？
このマクロは、開いているブックのすべてのシートのオートフィルターを解除します！

Sub psn全シートのオートフィルタ―の絞り込みを辞める()
    '全シートを標準ビューにする。
    Call msub全シートのオートフィルタ―の絞り込みを辞める(ActiveWorkbook)
End Sub

'   指定ブックについて全シートのオートフィルタ―の絞り込みを辞める。
'
'引数   ByVal wkbTarget As Workbook　対象ブック
'URL　https://pgbigoroku.hatenablog.com/entry/2022/08/23/142805
'
'2022/8/18
Public Sub msub全シートのオートフィルタ―の絞り込みを辞める(ByVal wkbTarget As Workbook)
    Dim intFor As Integer
    With wkbTarget
        .Activate
        For intFor = .Worksheets.Count To 1 Step -1
            If .Worksheets(intFor).FilterMode Then
                .Worksheets(intFor).ShowAllData
            End If
        Next
    End With
End Sub

EXCEL VBA 指定のセルにデータが入っているか確認します。

EXCEL VBA
指定セルにデータが入っているか
    MsgBox ni指定セルに値が入っているか(ActiveSheet, "B2:C2,D4:D5")
'
'   機能　　　:  指定のセルにデータが入っているか確認します。
'
'    返り値　　:     TRUE　文字が入力されている。
'                    FALSE 空白（LEN(0)の文字列）
'
'    引き数　　:    ByRef wksTarget As Worksheet　対象のワークシート
'                   ByVal pstrセルの場所A1形式 As String　確認したいセルをA1形式で指定
'    機能説明　:   　-
'
'    備考　　　:     -
'
'    この関数のURL　　：https://pgbigoroku.hatenablog.com/entry/2022/08/22/165014
'
'    バージョン　　：2022/8/21
Public Function ni指定セルに値が入っているか(ByRef wksTarget As Worksheet, ByVal pstrセルの場所A1形式 As String)
    Dim varFor As Variant
    For Each varFor In wksTarget.Range(pstrセルの場所A1形式)
        If Len(varFor) > 0 Then
            ni指定セルに値が入っているか = True
            Exit Function
        End If
    Next
    ni指定セルに値が入っているか = False
End Function

EXCEL VBA 複数シートを選択する

EXCEL VBA

ワークシートを複数したい場合に、配列でセレクトってRedimし直しで煩雑なコードになりませんか？
今回は、コレクションを利用してシンプルなコードで指定できるようにしました！

サンプル
「Sheet1とSheet3とSheet5を選択する。」

Sub test()
    Dim cllTemp As New Collection
    cllTemp.Add "Sheet5"
    cllTemp.Add "Sheet3"
    cllTemp.Add "Sheet1"
    ni複数シート選択 ActiveWorkbook, cllTemp
End Sub

'   機能　　　:  複数シートを選択する。
'
'    返り値　　:     -
'
'    引き数　　:    ByRef wkbTarget As Workbook　対象のワークブック
'                   ByRef pcll印刷シート名 As Collection    選択するワークシート名
'    機能説明　:   　存在しないシート名を指定した場合、エラーになります。
'
'    備考　　　:     -
'
'    この関数のURL　　：https://pgbigoroku.hatenablog.com/entry/2022/08/22/162205
'
'    バージョン　　：2022/8/21
'
Public Sub ni複数シート選択(ByRef wkbTarget As Workbook, ByRef pcll印刷シート名 As Collection)
    Dim arySheetName() As String
    Dim intFor As Integer
    ReDim arySheetName(0 To pcll印刷シート名.Count - 1)
    For intFor = 0 To pcll印刷シート名.Count - 1
        arySheetName(intFor) = pcll印刷シート名(intFor + 1)
    Next
    wkbTarget.Sheets(arySheetName).Select
End Sub