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是一个命名范围，指的是日期的主列表。一个动态示例，假设主列表从名为“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 数组中。在将结果写回工作表之前，所有计算都在这些数组上完成。

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

编辑：

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

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 回答