基于日期导入值：Excel 宏答案

【问题标题】：Importing Values based on Date: Excel Macro基于日期导入值：Excel 宏
【发布时间】：2013-02-26 20:11:47
【问题描述】：

我正在尝试为 Excel 编写一个相当智能的宏。在这种情况下，我有两个单独的工作簿，我在它们之间传输信息。第一个工作簿在 A 列中有日期列表，后面是以下列中的相应值。像这样：

如您所见，日期和值的输入不一致。它们仅在特定日期可用。当前条目在 2012 年底停止。这个宏的重点是每个月添加新数字。

工作簿 2 的摘录如下所示：

我当前的宏当前在工作簿 2 中找到正确的值并将它们复制到工作簿 1。除了日期不一致的可能性之外，这很好。 “CMP (3 YEARS)”部分可能有 15 天的价值，但“CMP (4 YEARS)”部分只有 14 天的价值。如果我盲目地将这些值复制到第一张纸上，它们将无法正确排列。如果缺少日期，我宁愿有一个计算出的平均值

为了解决这个问题，我正在尝试当前的解决方案：

    'Grab 1 Month
Call Import("CMA/FIXED     (4 WEEKS)", "B1", DestinationWorkbook, ExportedWorkbook, 3, 2, False, DestinationDateRange)

为要定位的每一列数字以及提取日期调用上述方法。

请允许我解释一下下面应该发生的事情。首先传入要在第二张表中搜索的字符串。它与 x 和 y 偏移整数一起使用以定位正确的值。 DestinationSheetName 是 Workbook1，ExportedDataSheetName 是 Workbook2。 isDateImport 布尔值用于告诉该方法这是第一次导入，我们所获取的只是将添加到 Workbook1 的 A 列的第一组日期。 ByRef DateRange 是指向这些日期的指针，这些日期已被复制并粘贴到 Workbook1 的 A 列。所以很明显，当它最初用于日期时，它是空的。

从那里我们检查我们正在做什么样的导入。如果是日期，我们只需进行简单的定位、复制和过去。如果不是，我们尝试智能导入定位值。这个想法是创建一个指向两组日期的指针，即 workbook1 中 A 列中的日期以及与我们正在复制的值相对应的日期。我们希望粘贴位置在每个日期的正确行中。我创建了两个指针并将它们指向两个日期列的开头。代替复制粘贴代码，我只是打印到调试窗口。如果指针值相互匹配。比较日期后，我尝试将指针递增到日期列中的下一个值。

这适用于 2 个日期，然后当我尝试增加指针时出现错误。

我应该怎么做才能修复这个错误？还是有更简单的方法来做到这一点？...我知道指针对于 Excel 电子表格来说有点矫枉过正...

Sub Import(SearchString As String, PasteLocation As String _
, DestinationSheetName As Variant _
, ExportedDataSheetName As Variant, xOffset As Integer, yOffset As Integer _
, isDateImport As Boolean, ByRef DateRange)


Windows(DestinationSheetName).Activate
Set newSpot = Range(PasteLocation).End(xlDown)
newSpot.Select 'remove
Set newSpot = newSpot.Item(2, 1)

Windows(ExportedDataSheetName).Activate
Cells.Find(What:=SearchString, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select


If Not isDateImport Then

    'intelligent import
    Set datesColumn = ActiveCell.Item(xOffset, yOffset)
    datesColumn.Select 'remove
    Set valuesColumn = datesColumn.Item(1, 2)
    valuesColumn.Select 'remove
    Set datesColumn = Range(datesColumn, datesColumn.End(xlDown))
    datesColumn.Select 'remove
    Set valuesColumn = Range(valuesColumn, valuesColumn.End(xlDown))
    valuesColumn.Select 'remove

    Set DateColumnPointer = datesColumn.Item(1, 1)
    DateColumnPointer.Select 'remove

    Set DateRangePointer = DateRange.Item(1, 1)
    Windows(DestinationSheetName).Activate
    DateRangePointer.Select 'remove

    For Each cell In valuesColumn
    If (DateColumnPointer = DateRangePointer) Then
        Debug.Print "Same"
    Else
        Debug.Print "Different"
    End If

    'increment Pointers
    Windows(ExportedDataSheetName).Activate
    DateColumnPointer = DateColumnPointer.Item(2, 1)


    Windows(DestinationSheetName).Activate
    DateRangePointer = DateRangePointer.Item(2, 1)

    Next
Else

'primitive import
Set cell1 = ActiveCell.Item(xOffset, yOffset)
If isDateImport Then
Set cell2 = cell1.End(xlDown)
Else
Set cell2 = cell1.End(xlDown).End(xlToRight)
End If
Set rng = Range(cell1, cell2)
rng.Select
rng.Copy

Windows(DestinationSheetName).Activate

If isDateImport Then
Range("W1").Select
Else
Range("V1").Select
End If

ActiveSheet.Paste

 'Add grabbed values
Set numbers = Range(Range("W1"), Range("W1").End(xlDown))
numbers.Copy
newSpot.PasteSpecial xlValues

End If

Windows(ExportedDataSheetName).Activate
Range("A1").Select
End Sub

【问题讨论】：

您是否在子程序之外全局设置了这些变量？

标签： excel pointers copy-paste vba

【解决方案1】：

您需要在增量指针部分中使用set 来逐步增加范围，否则您只需将值从下一个单元格复制到当前单元格。

'increment Pointers 
Windows(ExportedDataSheetName).Activate 
Set DateColumnPointer = DateColumnPointer.Item(2, 1)

Windows(DestinationSheetName).Activate 
Set DateRangePointer = DateRangePointer.Item(2, 1)

除非我错过了你的问题的重点？

【讨论】：