Ошибка времени выполнения 1004 при копировании значения переменной в конец столбца - PullRequest
1 голос
/ 17 марта 2019

Я пытаюсь объединить значения для ячеек в данной строке (скажем, C3: F3) и в той же строке (на том же листе) перейти к первой пустой ячейке слева от ячеек, которые были объединены (скажем, B3) и введите объединенные значения. Приведенный ниже код работает в первый раз, но я продолжаю получать ошибку времени выполнения 1004, когда следующая строка кода запускается ws.Range("B3").End(xlDown).Offset(1, 0).Value = varConctnt, то есть выбирается следующий набор ячеек в следующей строке (скажем, C4: F4) и я хочу ввести объединенное значение в ячейку B4. Я сделал все возможное, чтобы объявить объекты, чтобы обойти проблему, но ошибка продолжает появляться.

Спасибо заранее.

Sub ConcatenateReal2()

Dim rng As Range, iRow As Integer, iCol As Integer, i As Integer

Dim ws As Worksheet

Set ws = ActiveSheet

    ws.Range("C3").Select

    Set rng = ActiveSheet.Range(ActiveCell.End(xlToRight), ActiveCell.End(xlDown))

Dim varConctnt As Variant

    For iRow = 1 To rng.Rows.Count

    For iCol = 1 To rng.Columns.Count

        If Not rng(iRow, iCol).Value = vbNullString Then

        varConctnt = varConctnt & "," & rng(iRow, iCol).Value

    End If

    Next iCol

    Range("B3").Activate

    If IsEmpty(ActiveCell) Then

        ActiveCell.Value = varConctnt

    Else

        ws.Range("B3").End(xlDown).Offset(1, 0).Value = varConctnt

    End If

    varConctnt = ""

skip1:

    Next iRow

End Sub

1 Ответ

0 голосов
/ 17 марта 2019

(не проверено)

Sub ConcatenateReal2()

    Dim rng As Range, c As Range
    Dim sep, rw as Range, v, s

    With ActiveSheet.Range("C3")
        Set rng = .Parent.Range(.End(xlToRight), .End(xlDown))
    End With

    For Each rw in rng.Rows     'loop over rows
        sep = "" 'reset separator 
        s = ""
        For Each c in rw.Cells
            v = c.value
            If Len(v) > 0 Then
                s = s & sep & v
                sep = ","    
            end if
        next c
        rw.cells(1).offset(0, -1).value = s 
    Next rw     

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