TOP ▲ itcore TOP ＞ TIPS ＞ excel_vba_union.php 　タグ:excel vba

EXCEL VBA 複数のシートをunionで連結する。 | itcore 2019年

参考

EXCEL VBA スクリプトの実行

データシート


シートによってカラムの位置が違っていてもOK

実行結果



ファイル

Excelファイル

ソースコード

Option Explicit
Sub main()
  Dim i, sheet, cell, row, col, max_row, max_col, item, s1
  Dim items: items = Array("ID", "名前")
  Dim cols: Set cols = CreateObject("Scripting.Dictionary")

  ' ヘッダ出力
  s1 = items(0)
  For i = 1 To UBound(items)
    s1 = s1 & vbTab & items(i)
  Next
  Debug.Print s1

  ' 全シートのループ
  For Each sheet In ThisWorkbook.Worksheets
    ' 各項目についてカラム位置を調べる
    s1 = "": max_row = 0
    For i = 0 To UBound(items)
      item = items(i)
      cols(item) = ""
      row = 1
      ' カラム位置を調べる
      max_col = Columns.Count
      For col = 1 To max_col
        cell = sheet.Cells(row, col)
        If item = cell Then
          cols(item) = col
          Exit For
        End If
      Next
      If "" = cols(item) Then
        Debug.Print sheet.Name & "シートに" & item & "の項目が見つかりません。"
        End
      End If
    Next

    ' データの出力
    max_row = Rows.Count
    For row = 2 To max_row
      item = items(0)
      col = cols(item)
      cell = sheet.Cells(row, col)
      If "" = cell Then Exit For ' 最初の項目のデータがなくなったところで終了
      s1 = cell
      For i = 1 To UBound(items)
        item = items(i)
        col = cols(item)
        cell = sheet.Cells(row, col)
        s1 = s1 & vbTab & cell
      Next
      Debug.Print s1
    Next
  Next
End Sub



~