Объединить определенные c значений из ячейки с определенными c значениями из другой ячейки в конкретный формат

Question

          A                       B                                       C
1       numbers                  signs                                **Result**
2    *001*                 *alpha*                       001-alpha
3    *001*111*221*104*     *alpha*kappa*epislon*ETA*     001-alpha, 111-kappa, 221-epislon, 104-ETA
4    *001*085*             *alpha*delta*                 001-alpha, 085-delta

Я пытаюсь объединить значения в столбцах A и B в следующий формат в разделе результатов. Что-нибудь помогает, спасибо.

Answer 1

Формула решения

Использование функций Textjoin и Filterxml, из которых Textjoin доступно в Office 365 или Excel 2019 и Filterxml доступно в Excel 2013 и более поздних версиях Excel

В C2 формула массива (подтвердите, нажав Ctrl + Shift + Enter) скопирована:

=TEXTJOIN(", ",1,IFERROR(TEXT(FILTERXML("<a><b>"&SUBSTITUTE(A2,"*","</b><b>")&"</b></a>","//b"),"000")&FILTERXML("<a><b>"&SUBSTITUTE(B2,"*","</b><b>-")&"</b></a>","//b"),""))

Answer 2

Вот другой подход с использованием регулярных выражений ...

Option Explicit

Public Function Link(vNumbers As Range, vSigns As Range) As Variant

    ' ADD REFERENCE TO "Microsoft VBScript Regular Expressions 5.5"

    Dim vRegEx As New RegExp
    Dim vNumbersMatches As MatchCollection
    Dim vSignsMatches As MatchCollection
    Dim vCounter As Long

    ' The two parameters must only reference a single cell
    If vNumbers.Cells.Count <> 1 Or vSigns.Cells.Count <> 1 Then
        Link = CVErr(xlErrRef)
        Exit Function
    End If

    ' use regular expression to get the numbers
    vRegEx.Pattern = "([0-9]+)"
    vRegEx.Global = True
    vRegEx.MultiLine = True
    Set vNumbersMatches = vRegEx.Execute(vNumbers.Text)

    ' Use regular expression to get the signs
    vRegEx.Pattern = "([^\*]+)"
    vRegEx.Global = True
    vRegEx.MultiLine = True
    Set vSignsMatches = vRegEx.Execute(vSigns.Text)

    ' If the number of Numbers and Signs differs, then return an error
    If vNumbersMatches.Count <> vSignsMatches.Count Then
        Link = CVErr(xlErrValue)
        Exit Function
    End If

    ' Loop through the Numbers and Signs, appending each set
    For vCounter = 0 To vNumbersMatches.Count - 1
        Link = Link & vNumbersMatches.Item(vCounter) & "-" & vSignsMatches.Item(vCounter) & IIf(vCounter < vNumbersMatches.Count - 1, " ,", "")
    Next

End Function

И вывод ...

Answer 3

Я предполагаю, что это можно сделать с помощью формул, но это может стать громоздким, поэтому, возможно, UDF вроде этого:

Public Function JoinNumbersAndSigns(ByVal numbersRng As Range, ByVal signsRng As Range) As String
    Dim nums As String
    nums = numbersRng.Cells(1).Value
    nums = Mid$(nums, 2, Len(nums) - 2) ' remove leading and trailing *

    Dim signs As String
    signs = signsRng.Cells(1).Value
    signs = Mid$(signs, 2, Len(signs) - 2) ' remove leading and trailing *

    Dim tempNums As Variant
    tempNums = Split(nums, "*")

    Dim tempSigns As Variant
    tempSigns = Split(signs, "*")

    Dim i As Long
    For i = LBound(tempNums) To UBound(tempNums)
        Dim tempString As String
        Dim sep As String

        tempString = tempString & sep & tempNums(i) & "-" & tempSigns(i)
        sep = ", "
    Next i

    JoinNumbersAndSigns = tempString
End Function

В действии:

nums = Mid$(nums, 2, Len(nums) - 2) и аналогичную строку для signs, вероятно, можно было бы сделать более надежной, но она должна работать с вашими текущими данными.

Answer 4

До тех пор, пока всегда будет корреляция между количеством элементов в A и B, это будет работать

Sub SplitandConcat()

' Declare working vars
    Dim lRow As Long: lRow = 2
    Dim sOutputString As String
    Dim iWorkIndex As Integer
    Dim CommaSpace As String

While ActiveSheet.Cells(lRow, 1) <> ""

    CommaSpace = ""

    'Split the incomming string on delimiter
        arInput1 = Split(ActiveSheet.Cells(lRow, 1), "*")
        arInput2 = Split(ActiveSheet.Cells(lRow, 2), "*")

    ' For each non blank item in the 1st array join the corresponding item int the second
        For iWorkIndex = 0 To UBound(arInput1)
            If arInput1(iWorkIndex) <> "" Then
                ActiveSheet.Cells(lRow, 3) = ActiveSheet.Cells(lRow, 3) & CommaSpace & arInput1(iWorkIndex) & "-" & arInput2(iWorkIndex)
                CommaSpace = ", "
            End If
        Next iWorkIndex

' check next row
    lRow = lRow + 1
Wend

End Sub