VBAで全シートのA列をキーに列を結合するには

Question

実現したいこと

時刻	項目1	項目2
2025/3/23 0:00:00	111	222
2025/3/23 0:00:01	aaa	bbb

時刻	項目3	項目4
2025/3/23 0:00:01	a1	b1
2025/3/23 0:00:03	x1	y1

時刻	項目1	項目2	項目3	項目4
2025/3/23 0:00:00	111	222
2025/3/23 0:00:01	aaa	bbb	a1	b1
2025/3/23 0:00:03	x2	y2

発生している問題・分からないこと

全てのシートのA列は秒単位で吐き出されたもので、指定時間(例：2025/3/23 0:00:00)から1秒後のデータが各シートの列1にあり、同じ時間帯の全項目を一つのシートに集約したいです。

該当のソースコード

Sub Disp_clac_2()
    Dim i As Long, j As Long
    Dim Ave, Disp As Currency
    Dim StartTime, StopTime As Single
    Dim finalRow As Long
    Dim FinalCol As Long
    Dim シートNo As Long
    Dim Table As Variant
    
    For シートNo = 1 To Worksheets.Count

        finalRow = Worksheets(シートNo).Range("A1").End(xlDown).Row
        FinalCol = Worksheets(シートNo).Range("A1").End(xlToRight).Column
        
        
        Table = Worksheets(シートNo).Range("A2:C" & FinalCol).Value
        

    Next
    
    
    
    MsgBox Table(2, 1)
    
End Sub

Sub Workbook_Open()
Dim searchValue As String
Dim currentSheet As Worksheet
Dim cell As Range
Dim hitCount As Integer
Dim found As Boolean

' ユーザーフォームで検索語を入力する
searchValue = InputBox("2025/3/23  0:00:00")

' 全てのワークシートを検索する
For Each currentSheet In ActiveWorkbook.Worksheets
    ' C8からC1800の範囲を検索する
    For Each cell In currentSheet.Range("A2:C8")
        ' セルの値に検索語が含まれているかチェックする
        If InStr(1, cell.Value, searchValue, vbTextCompare) > 0 Then
            hitCount = hitCount + 1
            ' ヒットした場合はセルをアクティブにする
            currentSheet.Activate
            cell.Activate
            found = True
        End If
    Next cell
Next currentSheet

If found = False Then
    MsgBox "検索語が見つかりませんでした。"
ElseIf hitCount >= 2 Then
    MsgBox hitCount & "件のヒットがありました。"
End If
End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

Table(1,1)の時間が#2025/3/23#です。
Table(2,1)の時間が#2025/3/23 0:00:01#です。

また"2025/3/23 0:00:00"を検索したいですが、検索できていません。
何方かご存じでしたら、教えていただけますでしょうか。

補足

Alt+F11でOffice2021環境で実行しています。

Comments

[meg_]

> VBAで全シートのA列をキーに列を結合するには
> ユーザーフォームで検索語を入力する
課題はデータの結合ですか？文字列の検索ですか？何がしたくて今どこまで実装できているのでしょうか？？

[rena_168]

すみません、DBから抽出したデータが1つ目のシートまでできて、100個くらいのCSVを2つ目以降のシートまでしかできていません。
1つ目のシートのA列の時間(0:00:00～23:59:59)毎に、それ以降の100くらいのシート内容のA列の時間をキーに全シートの列結合がしたいですが、まだ全然書けていません＞＜

[meg_]

> すみません、DBから抽出したデータが1つ目のシートまでできて、100個くらいのCSVを2つ目以降のシートまでしかできていません。
「できて」「できていません」というのは何がどうなることを言っていますか？
質問文にはDBの話は出てきませんでしたが、データはDBに保存されているということですか？状況はよく分かりませんがDB上でデータ結合した方が良くないですか？（それができない理由等があるのであればそのあたりも質問文に追記しましょう）

[sk.exe]

> 全てのシートのA列は秒単位で吐き出されたもので、
> 指定時間(例：2025/3/23 0:00:00)から1秒後のデータが
> 各シートの列1にあり、同じ時間帯の全項目を一つのシートに集約したいです。

実行結果の 3 行目（[時刻]=#2025/3/23 0:00:03#）について、

・なぜ[項目3]と[項目4]ではなく[項目1]と[項目2]に値が代入されるのか。

・なぜ[項目1]に"x1"ではなく"x2"が、[項目2]に"y1"ではなく"y2"が代入されるのか。

という点が不明です。

> DBから抽出したデータ

> 100個くらいのCSV

おおもとのデータが何らかのデータベースから参照された複数のテーブルやビュー、
あるいは（ 1 つのフォルダ内に保存された）複数の CSV ファイルなのであれば、
VBA にこだわらず Power Query を使用するという方法も考えられるでしょう。

[rena_168]

説明が分かりにくくて、すみません。
項目3、項目4は、結合したときにわかりやすいため、そう書いただけです。
PLCからそれぞれのCSVが吐き出されていて、全データを１つのDBのテーブルに登録した(妥当かどうかはわかりませんが、そう決まったことです)もので、最終チェックで苦労しています。
私のやり方がやっぱり良くないのでしょうか。先輩のご指導をお願いします。

[sk.exe]

> PLCからそれぞれのCSVが吐き出されていて

・全ての CSV ファイルに共通して記録されている項目（列）は[時刻]のみである。
　（その列の名前は全てのファイルにおいて完全に統一されている）

・[時刻]以外の項目は多数あり、それらの列名や列数はファイルによってバラバラである。
　（同じ列名の項目が複数のファイルに記録されていることもあれば、
　そのファイルにしか記録されていない項目が存在していたりもする）

という前提であるとして、

> 全データを１つのDBのテーブルに登録した

「１つのDBのテーブル」というのは具体的に何を示しているのでしょうか。
Excel における「テーブル」と同じ意味でしょうか。
それとも何らかの外部データベース上のテーブルでしょうか。

また「登録『した』」とありますが、（meg_さんがたびたび指摘されていますが）
問題とされている「同じ時間帯の全項目を一つのシートに集約」自体は
既に出来ているのでしょうか。それとも出来ていないのでしょうか。

ここまでのご説明だと「個々の CSV ファイルのデータを別々のワークシート
（ 1 つのファイルにつき 1 つのワークシート）として読み込んだ 1 つのブックがある」
と解釈できるのですが、100 個ほどもある CSV ファイルをわざわざ 1 つずつ開く
作業でも行なわれたのでしょうか。

> 最終チェックで苦労しています。

その「最終チェック」とは具体的にどのような作業で、
どのような結果が得られれば完了となるのでしょうか。

それは「同じ時間帯の全項目を一つのシートに集約」とは
別の問題ではないのでしょうか。

[dodox86]

何となく、「自分で考えてできそうなところ」のVBAのコードをいきなり書き始めているから詰めのところでできなくなっちゃっているんじゃないかなと思えます。回答いただいてるように、基本的な設計をしてから進めればいいのに、と思える事案ですね。

> また"2025/3/23 0:00:00"を検索したいですが、検索できていません。
> 何方かご存じでしたら、教えていただけますでしょうか。

これはまた別の話(質問)になってしまうのではないでしょうか。

[meg_]

> PLCからそれぞれのCSVが吐き出されていて、全データを１つのDBのテーブルに登録した(妥当かどうかはわかりませんが、そう決まったことです)もので、最終チェックで苦労しています。

そのDBの内容がぐちゃぐちゃになっているということでしょうか？（値は登録されているが項目名が不明ということ？？）
そのDBの入力元であるCSVファイルが全てあるのであれば、sk.exeさんが言及されているようにPowerQueryで結合するのが良いかと思います。微調整が必要であれば結合後に処理すれば良いかと思います。PowerQueryで結合できない場合はその理由を質問に書かれると何かアドバイスできることがあるかもしれません。

[rena_168]

DBは100個くらいのCSVをもとに登録されていて、その最終確認で苦労しています。
PowerQueryは使ってことがないのですが、100個以上のCSVになるとExcel上の操作だけでできるものなんでしょうか。

[meg_]

Excelのlookup関数を使っても良いかもしれません。初回の作成は少々手間かと思いますがどうでしょうか？

> DBは100個くらいのCSVをもとに登録されていて、その最終確認で苦労しています。
具体的に苦労されている事が伝わらないのですが、皆さんの回答では解決しませんか？

Answer 1

「VBAで」と指定されていますが、とりあえず Power Query を使用する場合の例を挙げます。

使用するファイルについて

ある1つのフォルダの中に、以下の仕様を満たしたテキストファイルが1つ以上保存されているものとする。

• フォーマット: CSV 形式（可変長カンマ区切り）
• ファイル拡張子: .csv
• 文字エンコード: Shift_JIS
• 列見出し行: あり（1行目）
• 列数: 2列以上（可変。ファイルによって異なる）
• 列名: 1列目は[時刻]（全てのファイルに共通）。2列目以降はファイルによって異なる。
• [時刻]列のデータ型/形式: yyyy/m/d h:mm:ssなど datetime 型に変換可能な形式の文字列とする。

サンプルファイル

"時刻","項目1","項目2"
2025/3/23 0:00:00,"111","222"
2025/3/23 0:00:01,"aaa","bbb"

"時刻","項目3","項目4"
2025/3/23 0:00:01,"a1","b1"
2025/3/23 0:00:03,"x1","y1"

"時刻","項目1","項目5","項目6"
2025/3/23 0:00:03,"ddd",1,1690
2025/3/23 23:59:59,"dde",0,98
2025/3/24 0:00:00,"dzq",1,89210

Power Query エディターによるクエリの作成例

1: Excel 上で空のブックを新規作成する。

2: [データ]タブ -> [データの取得と変換]グループ -> [データの取得] -> [Power Query エディターの起動]をクリックし、Power Query エディターを起動する。

3: [ホーム]タブ -> [パラメーター]グループ -> [パラメーターの管理] -> [新しいパラメーター]をクリックし、テキスト型のパラメーターTargetFolderPathを作成、CSVファイルが保存されているフォルダの絶対パスを[現在の値]ボックスに入力する。

4: [ホーム]タブ -> [新しいクエリ]グループ -> [新しいソース] -> [その他のソース] -> [空のクエリ]をクリックし、空のクエリを新規作成する。

5: 作成されたクエリが選択された状態で[ホーム]タブ -> [クエリ]グループ -> [詳細エディター]をクリックし、詳細エディターを開く。

6: 詳細エディターに次のようなクエリを記述する。

let
    //キー列（日時データ）の名前を定義
    KeyColumnName = "時刻",
    //CSVファイル読込用のカスタム関数を定義
    LoadCsv = (CsvContent as binary) =>
        let
            //引数に渡されたバイナリデータを CSV ファイルとみなし、テーブルとして読み込む。ここでのエンコード方式は Shift_JIS とする。
            LoadedContent = Csv.Document(CsvContent,[Delimiter=",", Encoding=932]),
            //読み込んだテーブルの 1 行目のレコードを列見出しに昇格させる
            PromotedHeaders = Table.PromoteHeaders(LoadedContent)
        in
            PromotedHeaders,
    //テーブルレイアウト変換用のカスタム関数を定義
    TransformTable = (table1 as table) =>
        let
            //キー列のデータ型を datetime 型に変換する
            TransformedFirstColumnTypes = Table.TransformColumnTypes(table1,{{KeyColumnName, type datetime}}),
            //キー列以外の全ての列のピボットを解除する
            UnpivotedOtherColumns = Table.UnpivotOtherColumns(TransformedFirstColumnTypes, {KeyColumnName}, "属性", "値")
        in
            UnpivotedOtherColumns,
    //指定したフォルダ内のファイル情報をテーブルとして取得
    Source = Folder.Files(TargetFolderPath),
    //拡張子が .csv であるファイルのレコードを抽出する
    FilteredByExtension = Table.SelectRows(Source, each [Extension]=".csv"),
    //カスタム関数を使用して全ての CSV ファイルを読み込み、テーブルに変換する
    LoadedFiles = Table.TransformColumns(FilteredByExtension, {"Content", LoadCsv}),
    //キー列と同じ名前の列を含むテーブルのみを抽出する
    FilteredByHeader = Table.SelectRows(LoadedFiles, each List.Contains(Table.ColumnNames([Content]),KeyColumnName)),
    //カスタム関数を使用して全てのテーブルを同一レイアウトに変換する
    TransformedTable = Table.TransformColumns(FilteredByHeader, {"Content", TransformTable}),
    //変換された全てのテーブルをマージする
    CombinedTables = Table.Combine(TransformedTable[Content]),
    //[属性]列の値を新たな列見出しとして[値]列の値をピボット
    PivotedColumn = Table.Pivot(CombinedTables, List.Distinct(CombinedTables[属性]), "属性", "値"),
    //レコードをキー列の昇順に並べ替える
    SortedRows = Table.Sort(PivotedColumn,{{KeyColumnName, Order.Ascending}})
in
    SortedRows

7: 構文エラーがないことを確認したら、[完了]ボタンをクリックする。

8: プレビューにエラー表示がないことを確認したら、[クエリの設定]ウィンドウよりそのクエリを任意の名前に変更する。

9: [ホーム]タブ -> [閉じる]グループ -> [閉じて読み込む] -> [閉じて読み込む]をクリックする。

10: 追加されたワークシートの A 列の 2 行目から最後のデータ行までの範囲を選択する。

11: 選択範囲の表示形式をyyyy/mm/dd hh:mm:ss に変更する（秒を表示させる）。

変換結果

Answer 2

端的に言えば、エクセルで処理することではないと思いますRDBでの運用をご検討ください
どうしてもエクセルでしか対応できないというのであれば

1. 各シートからA列をコピーしてまとめシートのA列に流し込む
2. 重複の削除
3. 各シートのデータをindex+matchで抽出

という流れになると思います

参考

復数のシートのA列の値を「シートA」のA列に集約する方法

   Dim r1 As Range
    Dim r2 As Range
    Dim sheet As Worksheet
    Dim shukeiSheetName As String
    shukeiSheetName = "シートA"
    
    Dim allData() As Variant
    Dim uniqueData As Variant
    Dim newData() As Variant
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    For Each sheet In Sheets
        Set r1 = sheet.Range("A:A")
        If sheet.name <> shukeiSheetName Then
            If WorksheetFunction.CountIf(r1, "<>") > 0 Then
            Set r2 = r1.SpecialCells(xlCellTypeConstants)
            For Each cell In r2
               If Not IsEmpty(cell.Value) Then
                  If (Not Not allData) = 0 Then
                      n = 0
                  Else
                      n = UBound(allData) + 1
                  End If
                  ReDim Preserve allData(n)
                  allData(n) = cell.Value
               End If
            Next
           End If
         End If
    Next
    For i = 0 To UBound(allData)
        If Not dict.exists(allData(i)) Then
            dict.Add allData(i), True
        End If
    Next i
    uniqueData = dict.keys
    ReDim newData(UBound(uniqueData), 0)
    For i = 0 To UBound(uniqueData)
        newData(i, 0) = uniqueData(i)
    Next i
    Set sheet = Sheets(shukeiSheetName)
    If Not sheet Is Nothing Then
        sheet.Range(sheet.Cells(1, 1), sheet.Cells(UBound(uniqueData) + 1, 1)).Value = newData
    End If

Comments

[rena_168]

100個くらいのPLC測定のCSVデータがDB一つのテーブルに登録したもので、そのチェックで今苦労しています。（その仕様はよくないかもしれませんが、決まり事でしかたないです）
要するに、すべての時間の全項目をDBに登録していて、チェック方法で私はVBAでチェックしようとしていますが、もっといい方法がありましたら、教えていただきたいです。

すみません、RDBの運用はよくわからないので、また勉強が必要です＞＜

[yambejp]

>もっといい方法がありましたら

私が回答した内容で要件は足りると思いますがダメなのですか？

[rena_168]

YAMさんのやり方でできると思いますが、1日分のデータが100以上のCSVシートを関数入れて繰り返してやって5日分やるのがちょっと大変そうで、もっと作業短縮できる方法はないかなと思っているところです。
プログラムが出来る人なら、すぐそれで一発できそうですが、そういう能力がなくて、苦労しています＞＜
先輩なら、どうされますか？

[yambejp]

参考のソースをあげておきました
仕様が違うようなら指摘ください