Question

我在用最后一行变量定义变量时遇到麻烦。出现错误：

应用程序定义或对象定义的错误

LastRow = WorksheetFunction.Max(Sheets("stack").Cells(Rows.Count, "M").End(xlUp).Row + 1)
busdates = Sheets("stack").Range("M3" & ":" & "M & LastRow - 1")

我知道这与我的范围有关。有人可以帮忙吗？试图获取M3到M最后一行的范围。

然后我要像这样遍历busdates，

For d = 2 To busdates
    If ActiveSheet.Range("F") <> busdates Then
        ActiveSheet.Range("F2:K").Copy
        ActiveSheet.Range("M" & LastRow).PasteSpecial Paste:=xlPasteValues
    End If
Next

Answer 1

此处要复制的范围ActiveSheet.Range("F2:K").Copy尚未完全定义。 K列缺少一行。

假设busdates确实是一个范围，则应这样分配：

Dim busDates As Range
Set busDates = Sheets("stack").Range("M3:M" & lastRow - 1)

如果在循环中未使用d变量，但仍然循环遍历范围的行是没有意义的：

For d = 2 To busDates.Rows.Count + 2
    ActiveSheet.Range("F2:K" & lastRow).Copy
    ActiveSheet.Range("M" & lastRow).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
Next

可以像这样循环遍历busDates：

Dim myCell As Range

For Each myCell In busDates
    If myCell.Row > 2 Then
        'some cut and copy here
    End If
Next myCell

最后但并非最不重要的一点是，在VBA中应避免使用ActiveSheet，但是在这种情况下，它可能是无害的-How to avoid using Select in Excel VBA。

可以正常工作的整个代码在这里：

Sub TestMe()

    Dim lastRow As Long
    lastRow = WorksheetFunction.Max(Sheets("stack").Cells(Rows.Count, "M").End(xlUp).Row)
    lastRow = lastRow + 1

    Dim busDates As Range
    Set busDates = Sheets("stack").Range("M3:M" & lastRow - 1)

    Dim d As Long
    For d = 2 To busDates.Rows.Count + 2
        ActiveSheet.Range("F2:K" & lastRow).Copy
        ActiveSheet.Range("M" & lastRow).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    Next

End Sub

Answer 2

我还没有对任何数据进行过测试，但是您也许可以适应这样的情况

Option Explicit

Sub test()
    Dim DataArr() As Variant
    Dim BusDates() As Variant
    Dim PasteArr() As Variant
    Dim LastRow As Long
    Dim Cell1 As Variant
    Dim Cell2 As Variant
    Dim index As Long
    Dim Matched As Boolean
    Dim subcount As Long


    LastRow = Worksheets("stacks").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    DataArr() = Worksheets("stacks").Range("F2:K" & Worksheets("stacks").Cells(Rows.Count, "F").End(xlUp).Row).Value
    BusDates() = Worksheets("stacks").Range("M3:M" & LastRow).Value

    ReDim PasteArr(1 To 1, 1 To 6)
    subcount = 1

    For Cell1 = 1 To UBound(DataArr(), 1)
        For Each Cell2 In BusDates()
            If DataArr(Cell1, 1) Like Cell2 Then
                Matched = True
                Exit For                                      'if it matches it will exit
            ElseIf Cell2 Like BusDates(UBound(BusDates), 1) Then 'if it gets to the end, it's truly unique and needs to be added

                For index = 1 To 6
                    PasteArr(subcount, index) = DataArr(Cell1, index)
                Next index

                subcount = subcount + 1

                PasteArr = Application.Transpose(PasteArr)
                ReDim Preserve PasteArr(1 To 6, 1 To subcount)
                PasteArr = Application.Transpose(PasteArr)

                Matched = False

            End If
        Next Cell2

        If Matched = False Then
            BusDates = Application.Transpose(BusDates)
            ReDim Preserve BusDates(1 To UBound(BusDates) + 1)
            BusDates = Application.Transpose(BusDates)
            BusDates(UBound(BusDates), 1) = DataArr(Cell1, 1)
        End If

    Next Cell1
    Worksheets("stacks").Range("M" & LastRow + 1 & ":" & Cells(LastRow + UBound(PasteArr, 1) - 1, 18).Address).Value = PasteArr
End Sub

您需要两个for循环，以便可以遍历数据数组中的每个日期，并将其与M列中的每个日期进行比较，以确保其真正唯一。退出后，它会通过跳过其余比较来加快速度，从而加快了速度。

编辑：我已经对其进行了一些测试，并进行了一些更改，但这似乎可行。值得注意的是，如果您的数据不是正方形或矩形，LastRow将会搞砸，因为它可能最终会在比较数组中添加空字符或其他内容，并且在比较时会出现类型不匹配的情况Cell2

VBA，使用LastRow定义范围

2 个答案: