返回列表 上一主題 發帖

[發問] 如何從一段文字選出字詞

[發問] 如何從一段文字選出字詞

各位好
我有一個功能想做
就是每個人會有一段評語,也就是一段文字
但是我需要歸納出重點字詞

比如,評語是:善待動物有愛心,對人和氣,友愛同學,誠實不說謊
那我設按鈕,按下後會自動歸納出 :有愛心、和氣、誠實

擷取.JPG
2019-7-27 21:43


但是每個字詞就要用一個IF去判斷
如果有20種不同的字詞,不就要寫20個IF ?

規則可能像我想的,
*愛* --> 有愛心
*誠* --> 誠實
*和* --> 待人和氣
*友* --> 友愛同學 ... 等等

有辦法用VLOOKUP那種方式,或是在 另一個工作表,弄出這些規則字詞
然後程式會自己去參照的?

因為每個人評語不見得相同
但是我就要規納成重點字詞,還要能串接起來

再請各位大大幫我想想
謝謝

選字詞.rar (16.06 KB)
哈囉~大家好呀

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


==================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

對照表放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


======================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 3# 准提部林


    感謝版主的解答
    兩種方式都可以作用
    太感謝了
哈囉~大家好呀

TOP

回復 3# 准提部林


    你好,我想請問一下
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

這是因為都在同一個工作表中
Arr = Range([工作表1!E1], [工作表1!F65536].End(xlUp))
如果我的對照表是在 工作表3
直接改成
Arr = Range([工作表3!E1], [工作表3!F65536].End(xlUp))
好像會錯ㄟ

另外是

我的程式明明就有 For 然後中間有很大一段的程式  才出現 Next
F8逐行偵錯的時候,就跟我說只有NEXT 沒有 FOR
快瘋了
WITH 跟 END WITH 也一樣

不曉得有沒有類似的經驗
到底錯誤在哪裡

謝謝
哈囉~大家好呀

TOP

回復 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)
要看完整的程式才可判斷錯在哪???

========================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 6# 准提部林


    謝謝版主解答
原來還要設定這樣 Set xS = Sheets("工作表3")
我懂了

然後那個問題2
明明有FOR也有NEXT
卻警告錯誤

我上網找資料
發現如果 FOR 跟 NEXT 中間的程式 如果有用到IF 但卻忘記給 END IF
電腦卻只會笨笨的警告你FOR 跟NEXT錯了
不會去裡面找出缺了ENDIF
後來我就找到我程式錯誤的地方了

感謝
哈囉~大家好呀

TOP

        靜思自在 : 忘功不忘過,忘怨不忘恩。
返回列表 上一主題