准提部林

Private Sub CommandButton1_Click()
Dim TR, TT$, T, TX$, xR As Range
TX = "愛+有愛心/和+待人和氣/誠+誠實/友+友愛同學/孝+孝順"
For Each xR In Range([工作表1!A1], [工作表1!A65536].End(xlUp))
    For Each T In Split(TX, "/")
        TR = Split(T, "+")
        If InStr(xR.Value, TR(0)) Then TT = TT & "、" & TR(1)
    Next
    xR(1, 3) = Mid(TT, 2): TT = ""
Next
End Sub


==================================

准提部林

對照表放E:F欄:

Private Sub CommandButton1_Click()
Dim Arr, TT$, T, xR As Range
Arr = Range([工作表1!E1], [工作表1!F65536].End(xlUp))
For Each xR In Range([工作表1!A1], [工作表1!A65536].End(xlUp))
    For i = 1 To UBound(Arr)
        If Arr(i, 1) <> "" And InStr(xR, Arr(i, 1)) Then TT = TT & "、" & Arr(i, 2)
    Next i
    xR(1, 3) = Mid(TT, 2): TT = ""
Next
End Sub


======================================

准提部林

回復 5# iceandy6150


問1)
Private Sub CommandButton1_Click()
Dim Arr, TT$, T, xR As Range, xS As Worksheet
Set xS = Sheets("工作表3")
Arr = xS.Range(xS.Range("E1"), xS.Range("F65536").End(xlUp))
For Each xR In xS.Range(xS.[A3], xS.[A65536].End(xlUp))
    For i = 1 To UBound(Arr)
        If Arr(i, 1) <> "" And InStr(xR, Arr(i, 1)) Then TT = TT & "、" & Arr(i, 2)
    Next i
    xR(1, 3) = Mid(TT, 2): TT = ""
Next
End Sub

問2)
要看完整的程式才可判斷錯在哪???

========================