根据日期导入值:Excel宏

时间:2013-02-26 20:11:47

标签: excel-vba pointers copy-paste vba excel

我正在尝试为Excel编写一个相当智能的宏。在这种情况下,我有两个单独的工作簿,我正在之间传递信息。第一个工作簿列出了A列中的日期,后面跟着相应的值。像这样:

enter image description here

如您所见,日期和值未一致输入。他们只在某些日子可用。当前条目在2012年底停止。此宏的重点是每月添加新数字。

工作簿2的摘录如下所示: enter image description here

我当前的宏当前在工作簿2中找到正确的值并将它们复制到Workbook 1。 除了日期不一致的可能性之外,哪个很好。 “CMP(3年)”部分可能有15天的价值,但“CMP(4年)”部分只有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列后指向这些日期的指针。所以很明显,当这个用于日期时,这是空的。

从那里我们检查我们正在做什么样的导入。如果是日期我们只是做一个简单的定位,复制和过去。如果没有,我们会尝试智能导入定位的值。我们的想法是创建一个指向两组日期的指针,工作簿1中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

1 个答案:

答案 0 :(得分:0)

您需要在增量指针部分中使用set以递增方式增加范围,否则您只需将值从下一个单元格复制到当前单元格。

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

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

除非我错过了你的问题所在?