Необходимо объединить разное количество ячеек с помощью макроса

Question

Мне нужно объединить столбец ячеек на основе переменной в предыдущей ячейке. Это будет продолжаться до тех пор, пока не изменится указанная переменная. Например:

  A B C D  E
1 x     @1 @1+@2+@3
2 x     @2
3 x     @3
4 y     %1 %1+%2+%3
5 y     %2
6 y     %3
etc.

Мне нужен макрос, чтобы посмотреть на A1, и если это x, тогда начать объединенную строку в E1. Затем перейдите к A2, если это x, добавьте D2 к объединенному значению в E1, затем перейдите к A3, если это x, добавьте значение в D3 к объединенному значению в E1, и т. Д. Как только он попадет в новую переменную в столбце A ) процесс начинается заново. Это вообще возможно? Большое спасибо за вашу помощь!!

Answer 1

Это быстрый и грязный код, но он функционирует:

Dim i As Integer
Dim j As Integer
i = 1
j = 1

Dim initialValue As String

initialValue = Cells(i, 1).Value

Do While Cells(i, 1).Value <> ""
    Cells(j, 5).Value = ""
    Do While Cells(i, 1).Value = initialValue
        Cells(j, 5).Value = Cells(j, 5).Value & Cells(i, 4).Value
        i = i + 1
    Loop

   initialValue = Cells(i, 1).Value
   j = j + 1
Loop

Предполагается, что активным является лист с вашими столбцами. И номера столбцов жестко запрограммированы, и вы начинаете со строки 1.

Answer 2

Попробуйте это:

Dim row As Integer 
Dim col As Integer 
Dim working_row As Integer 
Dim rowVal As String, myStr As String 

rowVal = ""
row = 1
col = 4
While Cells(row, 1).Value <> ""
    If Cells(row, 1).Value <> rowVal Then
        myStr = ""
        working_row = row
        rowVal = Cells(row, 1).Value
    End If
    myStr = myStr & CStr(Cells(row, col).Value)
    Cells(working_row, col + 1).Value = myStr
    row = row + 1
Wend

Answer 3

Вот формула, вставьте в E2 и скопируйте вниз, что решит вашу проблему. Он не будет аккуратно помещать ваши ответы в E1, E4 и т. Д., Но будет каскадно спускаться вниз по столбцу.

Вы могли бы делать то же, что и после VBA.

Формула:

=IF(A2<>A1,D2,E1&D2)