標題: [發問] 如何從一段文字選出字詞 [打印本頁]

---

作者: iceandy6150    時間: 2019-7-27 21:48     標題: 如何從一段文字選出字詞

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

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

[attach]31089[/attach]

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

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

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

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

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

[attach]31090[/attach]

---

作者: 准提部林    時間: 2019-7-28 09:07

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


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

---

作者: 准提部林    時間: 2019-7-28 09:15

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


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

---

作者: iceandy6150    時間: 2019-7-30 08:51

回復 3# 准提部林


    感謝版主的解答
    兩種方式都可以作用
    太感謝了

---

作者: iceandy6150    時間: 2019-8-13 17:37

回復 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 也一樣

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

謝謝

---

作者: 准提部林    時間: 2019-8-14 10:10

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

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

---

作者: iceandy6150    時間: 2019-8-18 13:52

回復 6# 准提部林


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

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

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

感謝

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)