1

日付の列がいくつかあり、それらを1つのマスターリストにまとめました。このリストには、各リストに共通するすべての日付が含まれています。したがって、このリストの値は、他のすべての列で見つける必要があります。

複数のシート（1つの列に日付があり、隣接する列に値がある）にまたがるデータのテーブルがいくつかあります。日付の列は、これらのシートの各データテーブルから供給されるため、これらのシートには見つからない日付が含まれている可能性があります。マスターリストにあります。

マスターリストに含まれているすべての日付とそれに対応する値を、これらの各シートの隣接する列にコピーして貼り付けたいと思います。

例（すべてF13：GXの範囲で別々のシートにリストされています）（リスト1、リスト2、リスト3などのシート名を使用）。「カバー」と呼ばれるものを除いて、ワークブックのすべてのシートにリストが含まれます。リスト1

22/12/2012 1
23/12/2012 2
24/12/2012 3 
27/12/2012 4
28/12/2012 5

リスト2

22/12/2012 2
23/12/2012 10
24/12/2012 11
28/12/2012 15

リスト3

22/12/2012 2
23/12/2012 17
28/12/2012 22
29/12/2012 33

の日付と値をコピーして貼り付けたい

22/12/2012 
23/12/2012 
28/12/2012

リストごとに、H13：I15の範囲に貼り付けます

だから私は望ましい出力として持っているでしょう。

リスト1

22/12/2012 1 22/12/2012 1
23/12/2012 2 23/12/2012 2
24/12/2012 3 28/12/2012 5 
27/12/2012 4
28/12/2012 5

リスト2

22/12/2012 2  22/12/2012 2
23/12/2012 10 23/12/2012 10
24/12/2012 11 28/12/2012 15
28/12/2012 15

リスト3

22/12/2012 2  22/12/2012 2
23/12/2012 17 23/12/2012 17
28/12/2012 22 28/12/2012 22
29/12/2012 33

値がスキップされる場合、空白はありません。

4

1 に答える 1

2

最も簡単な解決策は、マクロではなく数式を使用することです。

与えられた例では、すべての「リスト」シートのH3に次の式を入力します。

=IFERROR(INDEX(MasterList,ROW()-ROW(F$13)+1),"")

そしてこれはI3にあります：

=IF(H13="","",INDEX(G:G,MATCH(H13,F:F,0)))

必要な限り、数式をコピーして記入します。

MasterList日付のマスターリストを参照する名前付き範囲です。マスターリストが「マスター」という名前のシートのセルA1で始まると仮定すると、動的な例は次のようになります（列に他に何もありません）。

=Master!$A$1:INDEX(Master!A:A,COUNTA(Master!A:A))

傾斜している場合は、これを上記の最初の数式に直接挿入できます。

注：上記の2番目の式はできるだけ単純にしています。その結果、マスターリストに一致する日付（または同等の数）がF1：F12の範囲にある場合、それは壊れます。


マクロソリューションが本当に必要/必要な 場合は、次の「かなり単純な」ものでうまくいくはずです。

Public Sub PasteMasterDates()

  Dim fn As WorksheetFunction: Set fn = Application.WorksheetFunction

  Dim wkstWorkSheet As Worksheet
  Dim varMasterArray As Variant
  Dim varDatesArray As Variant
  Dim varValuesArray As Variant
  Dim lngMasterUBound As Long
  Dim lngMasterIndex As Long
  Dim lngMatchIndex As Long
  Dim varNumberFormat As Variant

  With Worksheets("Master")
    With Range(.Range("A1:B1"), .Range("A1").End(xlDown))
      varNumberFormat = .Cells(1).NumberFormat
      varMasterArray = fn.Transpose(fn.Transpose(.Cells))
      lngMasterUBound = UBound(varMasterArray, 1)
    End With
  End With
  For Each wkstWorkSheet In Application.Worksheets
    With wkstWorkSheet
      If .Name Like "List *" Then
        With Range(.Range("F13"), .Range("F13").End(xlDown))
          varDatesArray = fn.Transpose(.Cells)
          varValuesArray = fn.Transpose(.Cells.Offset(ColumnOffset:=1))
          For lngMasterIndex = 1 To lngMasterUBound
            lngMatchIndex = fn.Match(varMasterArray(lngMasterIndex, 1), varDatesArray, 0)
            varMasterArray(lngMasterIndex, 2) = varValuesArray(lngMatchIndex)
          Next lngMasterIndex
          With .Cells.Offset(ColumnOffset:=2).Resize(RowSize:=lngMasterUBound)
            .NumberFormat = varNumberFormat
            .Resize(ColumnSize:=2) = varMasterArray
          End With
        End With
      End If
    End With
  Next wkstWorkSheet

End Sub


重要なポイント：

  1. マスターリストは、上記の数式ソリューションに従って、「マスター」という名前のシートにあると想定されています。
  2. これは、マスターリストと一致するF1：F12の範囲の日付/数値がある場合でも機能するようになりましたが、F13の上または左側に行が挿入されると、機能しなくなります。マクロを修正するまで、つまり。
  3. 「リスト」シートへの日付の追加/挿入、またはこれらのシートの追加は、自動的に許可されます。
  4. 貼り付けられた値の日付形式は、マスターリストの最初の日付からコピーされます。
  5. 速度上の理由から、シートデータはVBAアレイにロードされます。結果をシートに書き戻す前に、これらの配列に対してすべての計算が行われます。

注：マスターリストを生成するマクロを既に実行していると思います（不可能ではないにしても、数式を使用して実行するのは困難です）。現在行っているように、マクロを変更してマスターリストを作成してから使用できます。
または、実際にシートに保存せずにビルドして使用することもできます。辞書を使用してマスターリストを作成すると同時に、すべての「リスト」シートデータを配列の配列にロードすることをお勧めします。次に、配列の配列をもう一度ループします。今回は、マスターリストを使用して結果を生成します。

編集：

このバージョンのマクロでは、他のすべてのリストに含まれていないマスターリストの日付を使用できます。

Public Sub PasteMasterDates2()

  Const cMasterSheetName As String = "Master"
  Const cMasterStart As String = "A1"
  Const cLikeListSheetName As String = "List *"
  Const cListStart As String = "F13"

  Dim fn As WorksheetFunction: Set fn = Application.WorksheetFunction

  Dim wkstWorkSheet As Worksheet
  Dim varMasterArray As Variant
  Dim varDatesArray As Variant
  Dim varValuesArray As Variant
  Dim avarPasteDatesArray() As Double
  Dim avarPasteValuesArray() As Double
  Dim lngMasterUBound As Long
  Dim lngListUBound As Long
  Dim lngPasteUBound As Long
  Dim lngMasterIndex As Long
  Dim lngMatchIndex As Long
  Dim varNumberFormat As Variant

  With Worksheets(cMasterSheetName)
    With Range(.Range(cMasterStart), .Range(cMasterStart).End(xlDown))
      varNumberFormat = .Cells(1).NumberFormat
      varMasterArray = fn.Transpose(.Cells)
      lngMasterUBound = UBound(varMasterArray)
    End With
  End With
  For Each wkstWorkSheet In Application.Worksheets
    With wkstWorkSheet
      If .Name Like cLikeListSheetName Then
        With Range(.Range(cListStart), .Range(cListStart).End(xlDown))
          varDatesArray = fn.Transpose(.Cells)
          varValuesArray = fn.Transpose(.Cells.Offset(ColumnOffset:=1))
          lngListUBound = UBound(varDatesArray, 1)
          ReDim avarPasteDatesArray(1 To lngListUBound)
          ReDim avarPasteValuesArray(1 To lngListUBound)
          lngPasteUBound = 0
          For lngMasterIndex = 1 To lngMasterUBound
            lngMatchIndex = 0
            On Error Resume Next
            lngMatchIndex = fn.Match(varMasterArray(lngMasterIndex), varDatesArray, 0)
            On Error GoTo 0
            If lngMatchIndex _
            Then
              lngPasteUBound = lngPasteUBound + 1
              avarPasteDatesArray(lngPasteUBound) = varDatesArray(lngMatchIndex)
              avarPasteValuesArray(lngPasteUBound) = varValuesArray(lngMatchIndex)
            End If
          Next lngMasterIndex
          If lngPasteUBound _
          Then
            ReDim Preserve avarPasteDatesArray(1 To lngPasteUBound)
            ReDim Preserve avarPasteValuesArray(1 To lngPasteUBound)
            With .Cells.Offset(ColumnOffset:=2).Resize(RowSize:=lngPasteUBound)
              .NumberFormat = varNumberFormat
              .Cells = fn.Transpose(avarPasteDatesArray)
              .Offset(ColumnOffset:=1) = fn.Transpose(avarPasteValuesArray)
            End With
          End If
        End With
      End If
    End With
  Next wkstWorkSheet

End Sub
于 2013-01-20T05:29:37.180 に答える