Код конкатенации не работает по назначению

Question

Я написал код в Excel VBA для конкатенации значений до 7 столбцов в строке с^между ними. Я заметил, что если я введу одно значение в первые шесть столбцов, я получаю вывод без ^. Этого не происходит, если я заполнить ДО колонке 7 или 5. Код, как показано ниже:

Private Sub CommandButton21_Click() 
    Cells(2, 1).Select 
    Dim stri As String, eaid_1 As String, eaid_2 As String, eaid_3 As String, _ 
     eaid_4 As String, eaid_5 As String, eaid_6 As String, eaid_7 As String 
    Do Until Selection.Value = ""  
     eaid_1 = Selection.Value  
     eaid_2 = Selection.Offset(0, 1).Value  
     eaid_3 = Selection.Offset(0, 2).Value  
     eaid_4 = Selection.Offset(0, 3).Value  
     eaid_5 = Selection.Offset(0, 4).Value  
     eaid_6 = Selection.Offset(0, 5).Value  
     eaid_7 = Selection.Offset(0, 6).Value   
     stri = eaid_1 & "^" & eaid_2 & "^" & eaid_3 & "^" & eaid_4 & "^" & eaid_5 _ 
         & "^" & eaid_6 & "^" & eaid_7   
     Selection.Offset(0, 8).Value = stri  
     Selection.Offset(1, 0).Select 
    Loop 

    Cells(2, 9).Select 
    Dim x As String, y As String, z As String 
    Do Until Selection.Value = "" 
     x = Selection.Value 
     y = Right(x, 6) 
     z = Replace(y, "^", "") 
     x = Replace(x, y, z)   
     Selection.Offset(0, 0).Value = x 
     Selection.Offset(1, 0).Select 
    Loop 
End Sub 

Answer 1

Private Sub CommandButton21_Click() 
    Const NUM_COLS As Long = 7 
    Dim c As Range, rng As Range 

    Set c = Cells(2, 1) 
    Do While c.Value <> "" 
     Set rng = c.Resize(1, Application.CountA(c.Resize(1, NUM_COLS))) 
     c.Offset(0, NUM_COLS).Value = _ 
       Join(Application.Transpose(Application.Transpose(rng.Value)), "^") 
     Set c = c.Offset(1, 0) 
    Loop 
End Sub 

Некоторые пояснения:

• Вы должны избегать использования Select/Activate работать с диапазонами, и вместо того, чтобы использовать переменную диапазона (например, c выше)
• В DoWhile...Loop начинается с A2 и продолжается до c
• rng переменная версия добавляет объект Range, начинающийся с c и распространяющийся вправо на столько клеток, сколько есть значений (максимум до 7 ячеек). Функция рабочего листа CountA используется для подсчета количества значений, а Resize создает диапазон требуемого размера.
• Повторяемый Application.Transpose создает одномерную матрицу из 2-мерной матрицы, полученной для rng.Value. Не просите меня объяснить, почему это работает ;-)
• И наконец, Join принимает 1-мерный массив и возвращает одну строку с каждым элементом входного массива, объединенным со следующим и разделенным вторым аргументом ("^")

Answer 2

Приведенный ниже код будет «конкатенации» в каждой строке (где Колонка A имеет данные) и проверяет, каждая строка, где последний столбец имеет данные, затем он объединяет их вместе (добавление «^» между элементами массива). В настоящее время он помещает строку результата в Столбец I, как и в вашем посте).

Какова цель вашей второй петли? как должен выглядеть ваш окончательный результат?

Private Sub CommandButton21_Click() 

Dim Rng    As Range 
Dim stri   As String 
Dim eaid()   As Variant 
Dim lRow   As Long 
Dim i    As Long 
Dim LastColumn  As Long 

' start from Cell A2 
lRow = 2 
Do Until Range("A" & lRow).Value = "" 
    ' get the last column with data in current row 
    LastColumn = Cells(lRow, Columns.Count).End(xlToLeft).Column 
    ReDim eaid(1 To LastColumn) 

    Set Rng = Range("A" & lRow) 

    ' read all Range values to one-dimension array using Transpose 
    eaid = Application.Transpose(Application.Transpose(Rng.Resize(1, LastColumn).Value)) 

    ' read all array elements to String 
    For i = LBound(eaid) To UBound(eaid) 
     If i = LBound(eaid) Then 
      stri = stri & eaid(i) 
     Else 
      stri = stri & "^" & eaid(i) 
     End If 
    Next i 

    Rng.Offset(0, 8).Value = stri 
    stri = "" 
    lRow = lRow + 1 
Loop 

End Sub