объединяя все значения ячейки между восходящим диапазоном - PullRequest
Новая
       12

объединяя все значения ячейки между восходящим диапазоном

0 голосов
/ 12 марта 2020

Я пытаюсь выяснить, как объединить каждую ячейку (обычный текст) в столбце D между диапазонами, которые я установил в столбце A. Во время поиска я наткнулся на варианты конкатенации, textjoin и других функций, но, похоже, не смог найти правильную опцию.

В моем файле около 8000 значений (значение идентификатора в столбце A), поэтому оно должно быть автоматически заполнено, а не вручную. так как на это уйдут недели ...

Я добавил визуальное представление проблемы

enter image description here

Решение будет чтобы все ячейки были выбраны в столбце D между значениями «1» и «2» в столбце A и объединены вместе в столбце E в строке, где ячейка в столбце A не пуста. Я надеюсь, что кто-то может помочь мне с этой проблемой.

1 Ответ

0 голосов
/ 12 марта 2020

Попробуйте этот код, пожалуйста. Он должен быть очень быстрым, используя массивы и сразу возвращая построенные строки в конце: 

Sub testJoinBetweenLimits()
  Dim sh As Worksheet, arrInit As Variant, arrFin As Variant
  Dim strInit As String, i As Long, j As Long, refRow As Long
    Set sh = ActiveSheet 'use here your sheet
    arrInit = sh.Range("A2:D" & sh.Range("D" & Cells.Rows.Count).End(xlUp).Row).value
    ReDim arrFin(1 To 1, 1 To UBound(arrInit, 1))
    For i = 1 To UBound(arrInit, 1)
        If arrInit(i, 1) <> "" Then strInit = arrInit(i, 4): refRow = i: j = i + 1
        Do While arrInit(j, 1) = ""

            If arrInit(j, 4) <> "" Then
                strInit = strInit & ", " & arrInit(j, 4)
            Else
                arrFin(1, j) = Empty
            End If
            j = j + 1
                If j >= sh.Range("D" & Cells.Rows.Count).End(xlUp).Row Then
                    arrFin(1, refRow) = strInit
                    ReDim Preserve arrFin(1 To 1, 1 To refRow)
                    GoTo Ending
                End If
        Loop
        i = j - 1
        arrFin(1, refRow) = strInit: strInit = "": j = 0
    Next i
Ending:
    sh.Range("E2").Resize(UBound(arrFin, 2), 1).value = WorksheetFunction.Transpose(arrFin)
End Sub
...