Как сделать объединение более двух строк с помощью VBA Excel без возникновения ошибки времени выполнения? - PullRequest
0 голосов
/ 30 января 2019

Привет и всем привет.

Я новичок в этом кодировании VBA, и я не уверен, почему я столкнулся со следующей ошибкой:

VBA - Runtimeошибка 1004

до этого она работала хорошо, но когда я добавил больше в свой диапазон, эта ошибка выскочила, и отладчик продолжает указывать на Set myRng = Application.Union(.Range(myCopy), .Range(myCopy2)).

Я нене знаю, как исправить эту часть кода, и здесь я предоставляю полный код

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCopy2 As String
    Dim myCell As Range
    
    'cells to copy from Input sheet - some contain formulas
    myCopy = "D10, D12, D14, D16, D18, D20, D22, D24, D26, D28, D30, D32, D34, D36, D38, D40, D42, D46, D48, D50, D52, D54, D56, D58, D60, D62, D64, D66, D68, D70,D72, D74, D78, D80, D82, D86, D88, D90, D92, D94, D96, D98, D100, D102, D104, D106, D108, D110, D113"
    myCopy2 = "D115, D119, D121, D123, D125, D127, D129, D131, D133, D137, D139, D141, D143, D145, D147, D149, D151, D153, D155, D159, D163, D168, D170, D174, D178, D182, D184, D186, D191, D193, D195, D199, D201, D205, D203, D207, D209, D211, D215, D217, D219, D221, D223"
    
    
    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("IncidentDatabase")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = Application.Union(.Range(myCopy), .Range(myCopy2))
    End With
    

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("IncidentDatabase")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = Union(.Range(myCopy), .Range(myCopy2))

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With
End Sub

Я знаю, что уже существует бесчисленное множество вопросов, касающихся ошибки времени выполнения VBA 1004, но, продолжая читать их, я не нашел ответа.

Любая помощь и руководство с благодарностью,

1 Ответ

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

Проблема в том, что длина myCopy2 превышает 255.Максимальное количество символов в строке - 255 символов.

Вы можете разделить этот диапазон до предела

myCopy = "D10, D12, D14, D16, D18, D20, D22, D24, D26, D28, D30, D32, D34, D36, D38, D40, D42, D46, D48, D50, D52, D54, D56, D58, D60, D62, D64, D66, D68, D70,D72, D74, D78, D80, D82, D86, D88, D90, D92, D94, D96, D98, D100, D102, D104, D106, D108, D110, D113"
myCopy2 = "D115, D119, D121, D123, D125, D127, D129, D131, D133, D137, D139, D141, D143, D145, D147, D149, D151, D153, D155, D159, D163, D168, D170, D174, D178, D182, D184, D186, D191, D193, D195, D199, D201, D205, D203, D207, D209, D211, D215"
Dim myCopy2b As String
myCopy2b = "D217, D219, D221, D223"


Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("IncidentDatabase")

With historyWks
    nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With

With inputWks
    Set myRng = Application.Union(.Range(myCopy), .Range(myCopy2), .Range(myCopy2b))
End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...