쉼표를 추출하여 셀 범위에서 여러 값을 구분했습니다.

Question

각 셀에 고유한 값이 있는 데이터 행에서 값 집합(3개 또는 4개의 값 집합)을 가져오려고 합니다. 값 중 일부 또는 전부가 일치하면 대상 단일 셀 쉼표로 추출합니다. 필요한 경우 분리됩니다. 이를 달성하는 데 도움을 주시면 감사하겠습니다. 감사해요. 여기서 까다로운 부분은 조회할 값이 단일 셀에 쉼표로 구분되어 있다는 것입니다.

Answer 1

내 질문에 대답하더라도 아래 코드는 해당 개발자가 제안한 것입니다. 코드를 사용하기로 결정한 경우 시트의 데이터 위치에 따라 코드를 정렬해야 할 수도 있습니다.

1) 이 솔루션은 MrExcel의 Rick Rothstein이 제안했습니다.

Sub GetValues()

 Dim R As Long, C As Long, V As Variant, Txt As String
  For C = 11 To Cells(1, Columns.Count).End(xlToLeft).Column
    For R = 3 To Cells(Rows.Count, "A").End(xlUp).Row
      Txt = ""
      For Each V In Split(Cells(1, C).Value, ",")
        If Not Intersect(Rows(R), Columns("A:I")).Find(V, , , xlWhole, , , False, `enter code here`False) Is Nothing Then Txt = Txt & "," & V
      Next
      Cells(R, C).Value = Mid(Txt, 2)
    Next
  Next
End Sub

2) 다음은 또 다른 대체 코드입니다(Terry X에게 감사드립니다).

Sub Test()

startCol = 11

EndCol = 13

'EndCol = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column

StartRow = 5

EndRow = 7

'EndRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

Dim arr As Variant

Dim dataRng As Range

For i = StartRow To EndRow

     Set dataRng = Range(Cells(i, 1), Cells(i, 8))

     dataRng.Select

     For j = startCol To EndCol

     valueToLookUP = Cells(1, j).Value

     arr = Split(valueToLookUP, ",")

     resultStr = ""

     For k = LBound(arr) To UBound(arr)

     On Error Resume Next

     idx = WorksheetFunction.Match(arr(k), dataRng, 0)

     If idx > 0 Then

     resultStr = resultStr + "," + arr(k)

     End If

     idx = 0

     Next k

     If Len(resultStr) > 0 Then resultStr = Mid(resultStr, 2)

     Cells(i, j).Value = resultStr

     Next j

Next i

End Sub

3) 버튼을 사용한 또 다른 접근 방식(Ashidacchi에게 감사드립니다):

Option Explicit

Private kw1, kw2, kw3, kw4 As String
Private match1, match2, match3, match4 As String
Private strTarget As String

' ---[Smart Search]
Private Sub btn_SmartSearch_Click()
    Dim firstRow As Integer: firstRow = 5
    Dim lastRow As Integer: lastRow = Range("A99999").End(xlUp).Row
    ' ---
    Dim myRow As Integer
    For myRow = firstRow To lastRow
        Call prc_Clear_Match_KW             ' -- clear match1~match4, kw1~kw4
        Call prc_Create_TargetString(myRow) ' -- create strTarget
        ' ---
        If (strTarget <> "") And (Range("K1").Value <> "") Then
            Dim commaCnt As Integer ' -- the number of comma(s) in cell [K1]
            Dim kwCnt As Integer    ' -- the number of keyword(s) in cell [K1]
            ' ---
            commaCnt = Len(Range("K1")) - Len(Replace(Range("K1"), ",", ""))
            kwCnt = commaCnt + 1
            Call prc_Set_Keyword(kwCnt)
            'MsgBox "kwCnt=" & kwCnt
            ' --- kw ‚ª‘¶Ý‚·‚ê‚Î match ‚É kw ‚ðƒZƒbƒg
            If (InStr(strTarget, kw1) > 0) Then
                match1 = kw1
            End If
            If (InStr(strTarget, kw2) > 0) Then
                match2 = kw2
            End If
            If (InStr(strTarget, kw3) > 0) Then
                match3 = kw3
            End If
            If (InStr(strTarget, kw4) > 0) Then
                match4 = kw4
            End If
            ' --- set matching result to column [K]
            Call prc_Set_Result(myRow)
        End If
    Next
    ' ---
    MsgBox "[Smart Search] completed !!)"
End Sub
' -- create strTarget: concatenate cells 1 - 8
Private Sub prc_Create_TargetString(ByVal myRow As Integer)
    strTarget _
        = Cells(myRow, 1).Value & Cells(myRow, 2).Value _
        & Cells(myRow, 3).Value & Cells(myRow, 4).Value _
        & Cells(myRow, 5).Value & Cells(myRow, 6).Value _
        & Cells(myRow, 7).Value & Cells(myRow, 8).Value
        '' --- for debugging
        ' MsgBox "strTarget=" & strTarget
End Sub
' ---
Private Sub prc_Set_Keyword(ByVal kwCnt As Integer)
    Select Case kwCnt
        Case Is = 1     ' -- one Keyword
            kw1 = Mid(Range("K1").Value, 1, 1)
        Case Is = 2     ' -- two Keywords
            kw1 = Mid(Range("K1").Value, 1, 1)
            kw2 = Mid(Range("K1").Value, 3, 1)
        Case Is = 3     ' -- three Keywords
            kw1 = Mid(Range("K1").Value, 1, 1)
            kw2 = Mid(Range("K1").Value, 3, 1)
            kw3 = Mid(Range("K1").Value, 5, 1)
        Case Is = 4     ' -- four Keywords
            kw1 = Mid(Range("K1").Value, 1, 1)
            kw2 = Mid(Range("K1").Value, 3, 1)
            kw3 = Mid(Range("K1").Value, 5, 1)
            kw4 = Mid(Range("K1").Value, 7, 1)
    End Select
    '' --- for debugging
'    MsgBox "kw1=" & kw1 & Chr(13) & _
'           "kw2=" & kw2 & Chr(13) & _
'           "kw3=" & kw3 & Chr(13) & _
'           "kw4=" & kw4
End Sub
' ---
Private Sub prc_Clear_Match_KW()
    match1 = ""
    match2 = ""
    match3 = ""
    match4 = ""
    ' --
    kw1 = ""
    kw2 = ""
    kw3 = ""
    kw4 = ""
End Sub
' ---
Private Sub prc_Set_Result(ByVal myRow As Integer)
    Dim strResult As String: strResult = ""
    If (match1 <> "") Then
        strResult = match1
    End If
    If (match2 <> "") Then
        strResult = strResult & "," & match2


End If
    If (match3 = "") Then
        strResult = strResult & "," & match3
    End If
    If (match4 = "") Then
        strResult = strResult & "," & match3
    End If
    ' ---
    Do Until Left(strResult, 1) <> ","
        strResult = Mid(strResult, 2, Len(strResult) - 1)
    Loop
    Do Until Right(strResult, 1) <> ","
        strResult = Mid(strResult, 1, Len(strResult) - 1)
    Loop
    ' ---
    Cells(myRow, 11).Value = strResult
End Sub
' ---[Clear Result]
Private Sub btn_ClearResult_Click()
    Range("K5:T50").Value = ""
End Sub