Question

W.r.f 对我之前的问题 Link 我一直在尝试提取两个日期之间的 Col"A" 值。我通过 Excel 公式得到了解决方案，但我不知道使用大数据公式会花费很多时间来处理结果。

=AGGREGATE(14,6,A:A*(B:B>=$F$2)*(B:B<=$G$2),ROW(A1))

所以我厌倦了 VBA，如果 Col"B" 日期在两个日期之间 => 是 <=，那么复制 Col"A" 值并粘贴。

我尝试创建以下不完整的代码并尝试使其完整但无法完成，任何帮助将不胜感激 .

Dim s1 As Worksheet
    Dim s3 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s3 = Sheets("Sheet3")
    Set s4 = Sheets("Sheet4")
    Dim i As Long, lr As Long, lr3 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    
    Dim Dstart As Date
    Dim Dend As Date
    Dstart = s4.Range("M10").Value
    Dend = s4.Range("N10").Value
    

        For i = 2 To lr
            If s1.Range("B" & i) >= Dstart And .Range("B" & i) <= Dend Then
                s1.Range("A" & i).Copy
                s3.Range("X3:X" & i).Paste xlValues
            End If
        Next i

Answer 1

在 VBA 中工作时学习使用数组会大大受益，因为在内存中工作将使您的脚本成倍地运行。

为了让您走上正轨，这应该可以帮助您弄清楚：

    Option Explicit 'always add this
    
    Sub test()
        Dim arr, arr2, j As Long, i As Long, Dstart As Date, Dend As Date
        
        arr = Sheet1.Range("A1").CurrentRegion.Value 'get the dates in memory
        Dstart = Sheet1.Range("c1").Value
        Dend = Sheet1.Range("c2").Value
        ReDim arr2(1 To UBound(arr), 1 To 1) 'setup temp array
        i = 1 'don't like to start at 0
        For j = 1 To UBound(arr) 'traverse source dates
            If arr(j, 1) >= Dstart And arr(j, 1) <= Dend Then 'check if date is in range
                arr2(i, 1) = arr(j, 1) 'store matching dates in temp array
                i = i + 1
            End If
        Next j
        
        With Sheet2
            .Range(.Cells(1, 1), .Cells(UBound(arr2), 1)).Value = arr2 'paste to sheet
        End With
    End Sub

注意事项：

要复制的日期在 colA 中
开始结束在 colC 中
匹配结果粘贴在sheet2中

如果您有任何问题要根据您的特定设置进行调整，请不要犹豫。

过滤和复制粘贴值 VBA

1 个答案: