VBA, определить диапазон с LastRow

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

Я еще не проверял это ни с какими данными, но вы можете адаптировать что-то вроде этого

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, чтобы вы могли перебирать каждую дату в массиве данныхи сравните его с каждой датой в столбце М, чтобы убедиться, что она действительно уникальна.Выход для немного ускоряет его, пропуская остальные сравнения, когда он получает совпадение.

РЕДАКТИРОВАТЬ: Я немного протестировал и внес некоторые изменения, но это, кажется, работает.Стоит отметить, что LastRow испортится, если ваши данные не имеют квадратной или прямоугольной формы, потому что это может привести к добавлению нулевого символа или чего-то еще в массив сравнения, и вы получите несоответствие типов при сравнении Cell2

Answer 2

Диапазон для копирования здесь 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, но в этом случае он, вероятно, безвреден - Как избежать использования Select в 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