【ノーコード】VBAコードを作成する無料アプリ

AIで自分の価値を高める方法とは🙄

MENU

【ノーコードVBA】シフト表を日付でフィルターし、出勤者を転記する

エクセルVBAマクロを自動作成する無料アプリです。

例として「シフト表を日付でフィルターし、出勤者を転記する」マクロを作成します。
2つの事例があります。

事例1 B10セルで指定した日付の出勤者をA14セルに表示します

氏名、表の値が転記されました!

 

ポイント

【シート】

※"セルの"入力値"と、表の"列見出し"の書式は揃えます

【2】表の左上(A1セル)は空白不可です。

 

【3】”日にち”の欄は、TODAY関数も有用です。

【4】”休み”などの文字も可能です。

 

アプリの設定

アプリへのリンク
 ⇒表の上見出しを検索し、左見出しと値を表示する

 

 

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

 

VBAコードを見る

Sub デモ() '表の上見出しを検索し、左見出しと値を表示する
 
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止

 '変数の宣言
    Dim 対象シート As Worksheet, 入力値 As Range, 表 As Range, 最終行 As Long, 最終列 As Long
    Dim 列見出し As Range, 行見出し As Range, 出力行 As Long
    '対象シートの設定
    Set 対象シート = ThisWorkbook.Sheets("Sheet1")
'エラーメッセージ
    If Range("a1") = "" Then
       MsgBox "a1セルに値をいれてください"
       Exit Sub
    End If
'データクリア
    Dim データ最終行 As Long, データ最終列 As Long
    With 対象シート.Range("a14").CurrentRegion
        データ最終行 = Range("a14").Row + .Rows.Count - 2
        データ最終列 = Range("a14").Column + .Columns.Count - 1
        Range(対象シート.Range("a14"), 対象シート.Cells(データ最終行, データ最終列)).ClearContents      
    End With 
'入力値の設定
    Set 入力値 = 対象シート.Range("b10")
'表の範囲の設定
    With 対象シート
        最終行 = .Range("a1").End(xlDown).Row
        最終列 = .Range("a1").End(xlToRight).Column
        Set 表 = .Range(.Range("a1"), .Cells(最終行, 最終列))
    End With
'出力行の初期化
    出力行 = Range("a14").Row
'列見出しを調べるループ処理
    For Each 列見出し In 表.Rows(1).Cells
        If 列見出し.Value = 入力値.Value Then
            '行見出しを調べるループ処理
            For Each 行見出し In Range(表.Cells(2, 1), 表.Cells(最終行 - Range("a1").Row + 1, 1))
                If Not IsEmpty(Cells(行見出し.Row, 列見出し.Column)) Then
                    '該当する行見出しと表の値を出力する
                    対象シート.Cells(出力行, Range("a14").Column) = 行見出し.Value
                    対象シート.Cells(出力行, Range("a14").Column+1) = Cells(行見出し.Row, 列見出し.Column)
                    出力行 = 出力行 + 1
                End If
            Next 行見出し
        End If
    Next 列見出し
'画面更新と警告メッセージの設定を戻す
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

事例2 C10セルから右方向の複数セルで指定した日付の出勤者を表示します

氏名、表の値が転記されました!

 

アプリの設定

アプリへのリンク
 ⇒表の上見出しを検索し、左見出しと値を表示する

 

 

ポイント

【シート】

※"セルの"入力値"と、表の"列見出し"の書式は揃えます

【2】表の左上(A1セル)は空白不可です。

 

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

 

VBAコードを見る

Sub デモ() '表の上見出しを検索し、左見出しと値を表示する
 
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止

' 変数の宣言
    Dim 対象シート As Worksheet, 最終行 As Long, 最終列 As Long, 表 As Range, 列見出し As Range
    Dim 行見出し As Range, 値 As Range, 列カウント As Long, 行カウント As Long
' 対象シートを設定する
Set 対象シート = ThisWorkbook.Sheets("Sheet1")
'エラーメッセージ
    If Range("b2") = "" Then
       MsgBox "b2セルに値をいれてください"
       Exit Sub
    End If
'データクリア
    Dim データ最終行 As Long, データ最終列 As Long
    With 対象シート.Range("c11").CurrentRegion
        データ最終行 = Range("c11").Row + .Rows.Count - 2
        データ最終列 = Range("c11").Column + .Columns.Count - 1
        Range(対象シート.Range("c11"), 対象シート.Cells(データ最終行, データ最終列)).ClearContents      
    End With 
With 対象シート
    ' 最終行と最終列を取得する
    最終行 = .Range("b2").End(xlDown).Row
    最終列 = .Range("b2").End(xlToRight).Column
    ' 表を定義する
    Set 表 = .Range(.Range("b2"), .Cells(最終行, 最終列))
    ' 列カウントと行カウントを初期化する
    列カウント = 0
    行カウント = 0
    ' 検索する値をループする
    For Each 値 In Range(.Range("c10"), .Range("c10").End(xlToRight))
        ' 列見出しをループする
        For Each 列見出し In 表.Rows(1).Cells
            ' 列見出しと値が一致する場合、行見出しを書き出す
            If 列見出し.Value = 値.Value Then
                For Each 行見出し In Range(表.Cells(2, 1), 表.Cells(最終行 - Range("b2").Row + 1, 1))
                    If Not IsEmpty(.Cells(行見出し.Row, 列見出し.Column)) Then
                        .Range("c11").Offset(行カウント, 列カウント).Value = 行見出し.Value
                        行カウント = 行カウント + 1
                    End If
                Next 行見出し
                ' 行カウントをリセットする
                行カウント = 0
            End If
        Next 列見出し
        ' 列カウントをインクリメントする
        列カウント = 列カウント + 1
    Next 値
End With    
'画面更新と警告メッセージの設定を戻す
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

「セルの値の変更で、コードを自動実行する」マクロ

さらに便利な機能を追加します。この例では”A15”セルの値が変更されると上記のマクロを自動実行します。

 

ChatGPTで修正

あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です!

アプリはこちらから↓↓↓↓