![从单元格区域中提取逗号分隔的多个值](https://linux22.com/image/1538369/%E4%BB%8E%E5%8D%95%E5%85%83%E6%A0%BC%E5%8C%BA%E5%9F%9F%E4%B8%AD%E6%8F%90%E5%8F%96%E9%80%97%E5%8F%B7%E5%88%86%E9%9A%94%E7%9A%84%E5%A4%9A%E4%B8%AA%E5%80%BC.png)
答案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