macros只能粘贴值，如果它们也在主列表中find

我有几列date，我已经将其列入一个主列表，其中包含每个列表的共同date。 因此，这个列表中的任何值都必须在所有其他列中find。

我有几张数据表，跨多张（date在一列，数值在相邻的），date列从这些表中的每个数据表中提供，因此这些表可能包含未find的date在主列表中。

我想复制并粘贴到相邻的列中，在这些表中的每一张上，包含在主列表中的所有date和它们对应的值。

示例（全部列在单独的图纸上，范围为F13：GX）（使用列表1，列表2，列表3等表格名称）。 工作簿中的所有工作表都将包含一个列表，除了一个名为“Cover”的表格外）。 清单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 

我希望它复制和粘贴date和值

 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

最简单的解决scheme是使用公式而不是macros。

对于给出的例子，在每个“列表”表的H3中input这个公式：

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

这一个在I3：

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

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

MasterList是引用date主列表的命名范围。 一个dynamic的例子，假设主列表在名为“Master”的表格的单元格A1中开始（列中没有任何内容），将是：

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

你可以，如果这样倾向，直接插入到上面的第一个公式。

注：我保持上面的第二个公式尽可能简单。 因此，如果在与主列表匹配的范围F1：F12中有任何date（或等同的数字），将会中断。

如果你真的想/需要一个macros观解决scheme，下面的“相当简单”应该做的伎俩：

 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. 根据上面的公式解决scheme，假定主列表位于名为“主”的工作表中。
2. 现在，即使在与主列表匹配的范围F1：F12中存在date/数字的情况下，如果在上方插入了行，或者在F13的左侧插入了列，它也会中断。 直到你修复macros，那是。
3. 向“列表”工作表中添加/插入date或添加更多这些工作表是自动允许的。
4. 粘贴值的date格式从主列表中的第一个date复制而来。
5. 出于速度的原因，表单数据被加载到VBA数组中。 在将结果写回到工作表之前，所有的计算都在这些数组上完成。

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

编辑：

此版本的macros允许主列表中的date不在每个其他列表中。

 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