Ошибка выполнения 424: ошибка «Требуется объект» в VBA - PullRequest
0 голосов
/ 30 апреля 2019

Я пытаюсь сложить данные из нескольких листов в один мастершет (лист, на котором я запускаю этот макрос).Так что, по сути, один и тот же код повторяется несколько раз.Я также хочу выделить дубликаты в первом столбце и, таким образом, последний бит об этом.Не могу понять, почему я получаю ошибку «Требуется объект».Любая помощь будет принята с благодарностью.

Sub Stackdata()
Dim emptyrow As Long, lastrow As Long, lastcolumn As Long



Workbooks.Open ”Declined.csv”
Worksheets(1).Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
ActiveWorkbook.Close

Worksheets(1).Select
emptyrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(emptyrow, 1).Select
ActiveSheet.Paste


Workbooks.Open ”Offersbutwithdrawn.csv”
Worksheets(1).Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
ActiveWorkbook.Close

Worksheets(1).Select
emptyrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(emptyrow, 1).Select
ActiveSheet.Paste



Dim iWarnColor As Integer
Dim rng As Range
Dim rngCell As Variant


Set rng = Range("A1:A200") ' area to check '
iWarnColor = xlThemeColorAccent2
For Each rngCell In rng.Cells
    vVal = rngCell.Text
    If (WorksheetFunction.CountIf(rng, vVal) = 1) Then
        rngCell.Interior.Pattern = xlNone
    Else
        rngCell.Interior.ColorIndex = iWarnColor
End If
Next rngCell


End Sub

1 Ответ

0 голосов
/ 30 апреля 2019

Я сократил ваш код и удалил все, что связано с .Select, чтобы избежать ошибок. Думаю, я не вижу, откуда возникла ошибка. Дайте мне знать, если этот код работает для вас. Если он не вернется после отладки строки ошибки и сообщите нам:

Option Explicit
Sub Stackdata()

    Dim emptyrow As Long, lastrow As Long, lastcolumn As Long, i As Long
    Dim wb As Workbook, wbSource As Workbook, arrWorkbooks, ws As Worksheet, wsSource As Worksheet

    arrWorkbooks = Array("Declined.csv", "Offersbutwithdrawn.csv") 'here you can add as many workbooks as you need

    'reference and declare workbooks and worksheets to avoid .Select
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)

    'A loop through all your workbooks on the variable arrWorkbooks
    For i = 0 To UBound(workbooks)
        Set wbSource = workbooks.Open(arrWorkbooks(i), ReadOnly:=True) 'thought you need the full path before the file name
        Set wsSource = wbSource.Sheets(1)
        emptyrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
        With wsSource
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
            .Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy ws.Cells(emptyrow, 1)
        End With
    Next i


    Dim iWarnColor As Integer
    Dim rng As Range
    Dim rngCell As Variant

    With ws
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Range("A1:A" & lastrow) ' area to check ' now it gets to the last row always
        iWarnColor = xlThemeColorAccent2
        For Each rngCell In rng.Cells
            vVal = rngCell.Text
            If (WorksheetFunction.CountIf(rng, vVal) = 1) Then
                rngCell.Interior.Pattern = xlNone
            Else
                rngCell.Interior.ColorIndex = iWarnColor
            End If
        Next rngCell
    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...