Разделите две колонки по разделителю и объедините их, шагнув от каждой к другой (EXCEL 2016)

Question

Хорошо, у меня есть два столбца данных следующим образом

Personalisation Max Char | Personaisation Field
       1x15x25           | Initial, Name, Date

Ранее я использовал следующую функцию vba (так как в Excel16 нет TEXTJOIN)

Function TEXTJOIN(delim As String, skipblank As Boolean, arr)
Dim d As Long
Dim c As Long
Dim arr2()
Dim t As Long, y As Long
t = -1
y = -1
If TypeName(arr) = "Range" Then
    arr2 = arr.Value
Else
    arr2 = arr
End If
On Error Resume Next
t = UBound(arr2, 2)
y = UBound(arr2, 1)
On Error GoTo 0

If t >= 0 And y >= 0 Then
    For c = LBound(arr2, 1) To UBound(arr2, 1)
        For d = LBound(arr2, 1) To UBound(arr2, 2)
            If arr2(c, d) <> "" Or Not skipblank Then
                TEXTJOIN = TEXTJOIN & arr2(c, d) & delim
            End If
        Next d
    Next c
Else
    For c = LBound(arr2) To UBound(arr2)
        If arr2(c) <> "" Or Not skipblank Then
            TEXTJOIN = TEXTJOIN & arr2(c) & delim
        End If
    Next c
End If
TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - Len(delim))
End Function

Это изменит 1x15x25 на 1-1, 2-15, 3-25, используя следующую формулу

{=TEXTJOIN(", ",TRUE,ROW(INDIRECT("1:" & LEN(A1)-LEN(SUBSTITUTE(A1,"x",""))+1)) & "  - " & TRIM(MID(SUBSTITUTE(A1,"x",REPT(" ",999)),(ROW(INDIRECT("1:" & LEN(A1)-LEN(SUBSTITUTE(A1,"x",""))+1)) -1)*999+1,999)))}

Из-за того, что мой оригинальный метод не был достаточно конкретным, я был вынужден вернуться к чертежной доске.

Сверху я хочу произвести следующее.

1-2-Initial, 2-15-Name, 3-25-Date

Я разработчик, но не в Visual Basic, и худшая часть: я знаю, что я буду делать с базой данных, а у PHP просто недостаточно знаний, чтобы передать это, чтобы преуспеть.

Так что мне нужно либо по формуле, либо по функции

• Взять 2 столбца и разделить их разделителем
• Затем посчитайте записи по каждому (может быть, только по одному)
• Затем для каждого в диапазоне создайте новую строку, добавив count-col1-col2

Я не могу изменить данные, указанные поставщиком

У меня есть базовое понимание VBA, поэтому объясните, не умаляйте

ОБНОВЛЕНО (ОБЗОРЫ ДАННЫХ) В этом примере используется формула, приведенная выше, слегка потрясенная.

Как видите, каждая строка снова начинает отсчет. Игнорируйте части строки Персонализация / Сообщение, которые я могу добавить позже

Answer 1

Sub test()
    Dim rngDB As Range
    Dim vR() As Variant
    Dim i As Long

    Set rngDB = Range("a2", Range("a" & Rows.Count).End(xlUp)) '<~~personaliation Max Char data range
    ReDim vR(1 To rngDB.Count, 1 To 1)

    For i = 1 To rngDB.Count
        vR(i, 1) = textjoin(rngDB(i), rngDB(i, 2))
    Next i
    Range("c2").Resize(rngDB.Count) = vR '<~ result wil be recorded in Column C

End Sub

Function textjoin(rng1 As Range, rng2 As Range)
    Dim vS1, vS2
    Dim vR()
    Dim i As Integer
    vS1 = Split(rng1, "x")
    vS2 = Split(rng2, ",")
    ReDim vR(UBound(vS1))
    For i = LBound(vS1) To UBound(vS1)
        vR(i) = i + 1 & "-" & Trim(vS1(i)) & "-" & Trim(vS2(i))
    Next i
    textjoin = Join(vR, ",")
End Function

Answer 2

СПАСИБО ЗА ВСЕ ПОМОЩЬ

Я вернулся к чертежной доске, увидев выше.

Я узнал

• Это мое первоначальное использование формулы массива и TEXTJOIN, где слишком много и вряд ли упрощенно
• То, что я могу использовать VBA, как и любой другой программный код:)

Мое решение упрощено с Dy.Lee

Function SPLITANDMERGE(arr1 As String, arr2 As String, Optional del1 As String = "x", Optional del2 As String = ",")
    'Arr1 Split'
    Dim aS1

    'Arr2 Split'
    Dim aS2

    'Value Array'
    Dim r()

    'Value Count'
    Dim v As Integer

    'Split The Values'
    aS1 = Split(arr1, del1)
    aS2 = Split(arr2, del2)

    'Count The Values'
    ReDim r(UBound(aS1))

    'For All The Values'
    For v = LBound(aS1) To UBound(aS2)

        'Create The String'
        r(v) = "Personalisation_Line " & v + 1 & " - " & Trim(aS1(v)) & " Characters - [" & Trim(aS2(v)) & "]"

    Next v

    'Join & Return'
    SPLITANDMERGE = Join(r, ", ")

End Function

Я все еще работаю над этим, но теперь я получаю следующий результат.

Будет добавлено:

• Сравнение значений (если у нас есть 4 и 5 значения, возвращаемое "-", которое будет принято условным форматированием)
• Условные множественные значения (Если значение 2 в строке равно 0, то символ вместо символов

Если есть какие-либо подводные камни или ошибки, которые кто-либо может увидеть, пожалуйста, просветите меня. Я здесь, чтобы учиться.

Answer 3

Я нахожусь в мега-порыве, так что только подытожил это с одним рядом значений (в A1 и B1)

Я надеюсь, что вы можете пройти через это, чтобы понять это, обернуть его в другой цикл, чтобы пройти через ваши 6000 строк, и изменить msgbox на любую нужную область вывода ... 6000 строк должны быть очень быстрыми:

Sub go()
Dim a() As String
Dim b() As String
Dim i As Long
Dim str As String

' split A1 and B1 based on their delimiter, into an array a() and b()
a() = Split(Range("A1").Value2, "x")
b() = Split(Range("B1").Value2, ",")

' quick check to make sure arrays are same size! 
If UBound(a) <> UBound(b) Then Exit Sub

' this bit will need amended to fit your needs but I'm using & concatenate to just make a string with the outputs
For i = LBound(a) To UBound(b)
    str = str & i + 1 & "-" & a(i) & "-" & b(i) & vbNewLine
Next i

' proof in the pudding
MsgBox str

End Sub