VBA，使用LastRow定义范围

Question

I am having trouble defining my variable with my last row variable. Getting error:

application-defined or object defined error

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

I know it is something to do with my range. Can someone help with the format of this? Trying to get the range of M3 to M Last row.

then I'm trying to loop through busdates like so,

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

The range to be copied here ActiveSheet.Range("F2:K").Copy is not completely defined. There is a row for the K column missing.

---

Gessing that busdates is inteded to be a range, then it should be assigned as such:

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

And looping through the rows of a range is a bit meaningless, if the d variable is not used in the loop, but still:

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

Probably looping through busDates could be done like this:

Dim myCell As Range

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

Last but not least, the ActiveSheet is to be avoided in VBA, but in this case it is probably harmless - How to avoid using Select in Excel VBA .

The whole code that works somehow is here:

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

I haven't tested this with any data yet, but you might be able to adapt something like this

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

You need two for loops so that you can iterate through each date in the data array and compare it to every date in the M column to ensure that it's truly unique. The exit for speeds it up a little bit by skipping the rest of comparisons once it gets a match.

EDIT: I've tested it a little and made some changes but this seems to work. It's worth noting that the LastRow will screw up if your data isn't in a square or rectangular shape because it might end up adding an null character or something to the compare array and you'll get a type mismatch when comparing Cell2