如果宏也在主列表中找到，则只能粘贴值

Question

我有几列日期，我已经提炼成一个主列表，其中包含每个列表共有的所有日期。因此，必须在所有其他列中找到此列表中的任何值。

我有多个数据表，跨多个工作表（在一列中有日期，在相邻的一个中有值），日期列从这些工作表中的每个数据表中提供，因此这些工作表可能包含日期在主列表中找不到。

我想复制并粘贴到每个工作表上的相邻列中，包含在主列表中的所有日期及其对应值。

示例（全部列在单独的表格中，范围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

跳过值时不会出现空白。

Answer 1

最简单的解决方案是使用公式而不是宏。

对于给出的示例，在每个“列表”表单的H3中输入此公式：

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

和I3中的这个：

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

根据需要复制/填写公式。

MasterList是一个命名范围，指的是主日期列表。一个动态示例，假设主列表在名为“Master”的工作表的单元格A1中开始（列中没有其他内容），将是：

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

如果愿意的话，你可以直接将其插入上面的第一个公式中。

注意：我保持上面的第二个公式尽可能简单。因此，如果在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. 根据上面的公式解决方案，假定主列表位于名为“Master”的工作表中。
2. 虽然现在即使在F1：F12范围内存在与主列表匹配的日期/数字，但如果在上面插入行，或者在F13的左侧插入列，将中断。在你修复宏之前，就是这样。
3. 自动允许在“列表”表格中添加/插入日期，或添加更多这些表格。
4. 粘贴值的日期格式将从主列表中的第一个日期开始复制。
5. 出于速度原因，工作表数据将加载到VBA阵列中。在将结果写回工作表之前，所有计算都在这些数组上完成。

注意：因为我认为你已经在运行一个宏来生成主列表（只通过公式这样做很难，如果不是不可能的话），你可以修改我的宏来构建主列表，就像你现在一样，在使用它之前 或者，您可以构建和使用它，而无需将其实际保存到工作表中。我建议将所有“List”表格数据加载到一个数组数组中，同时使用字典构建主列表。然后再次遍历数组数组，这次使用主列表生成结果。

修改

此版本的宏允许主列表中的日期不在每个其他列表中。

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