標題: Ｂ欄要取出符合Ｄ欄內的關鍵字 [打印本頁]

---

作者: leiru    時間: 2021-11-8 10:09     標題: Ｂ欄要取出符合Ｄ欄內的關鍵字

Ｂ欄要取出符合Ｄ欄內的關鍵字，請問如何設定公式，謝謝。

---

作者: samwang    時間: 2021-11-8 10:49

回復 1# leiru


附件資料夾是空的，請再確認，謝謝

---

作者: leiru    時間: 2021-11-8 11:46

回復 2# samwang


    謝謝告知,附上檔案

---

作者: samwang    時間: 2021-11-8 13:33

回復 3# leiru

Sub test()
Dim Arr, xD, Reg, xE, T$, T1$, i%, j%, a
Set xD = CreateObject("Scripting.Dictionary")
Set Reg = CreateObject("VBScript.RegExp")
Arr = Range([d1], [d65536].End(3))
For i = 2 To UBound(Arr): T = Arr(i, 1): xD(T) = "": Next
Arr = Range([b1], [a65536].End(3))
For i = 2 To UBound(Arr)
    T = Arr(i, 1)
    With Reg
        .Global = True
        .IgnoreCase = True
        .Pattern = "[\u4e00-\u9fa5()]+"
        Set xE = .Execute(T)
        a = Split(Trim(.Replace(T, "")), "、")
        For j = 0 To UBound(a)
            If Left(a(j), 2) <> "AA" Then
                pos = InStr(1, a(j), "AA")
                T = Mid(a(j), pos, Len(a(j)))
            Else
                T = a(j)
            End If
            If xD.Exists(T) Then: T1$ = T1$ & "、" & T
        Next
        Arr(i, 2) = Mid(T1, 2): T1 = ""
    End With
Next
[a1].Resize(UBound(Arr), 2) = Arr
End Sub

---

作者: hcm19522    時間: 2021-11-8 16:12

https://blog.xuite.net/hcm19522/twblog/590110909

---

作者: leiru    時間: 2021-11-9 15:31

回復 5# hcm19522

請問我照公式設定,mark範圍B2:E7,
在B2儲存格輸入=IFERROR(IF(COLUMN(A1)=1,"","、")&INDEX($D:$D,SMALL(IF(ISNUMBER(0/(FIND($D$10:$D$18,"@"&$A2)-1)),ROW($10:$18)),COLUMN(A1)))&C2,"")
按ctrl+shift+enter

但沒顯示出希望結果

---

作者: hcm19522    時間: 2021-11-9 15:45

本帖最後由 hcm19522 於 2021-11-9 15:53 編輯

回復 6# leiru


   已成區域陣列  B2:B7先一起刪 B2重新 在右拉 下拉
  A5 多個 3

---

作者: 准提部林    時間: 2021-11-10 21:07

如果excel版本沒有TEXTJOIN函數, 用vba寫個類似的自訂函數:
[attach]34367[/attach]

公式//陣列
=TEXTJOIN("、",1,IF(1-ISERR(0/(FIND(D$2:D$16,"_"&A2)>1)),D$2:D$16,""))

---

作者: Andy2483    時間: 2023-12-11 08:14

謝謝論壇,謝謝各位前輩
後學藉此帖練習VBA,學習方案如下,請各位前輩指教
執行前:
[attach]37114[/attach]

執行結果:
[attach]37115[/attach]

Option Explicit
Sub TEST()
Dim Brr, Crr, i&, x%, T$, T1$
Brr = Range([D2], [D65536].End(3))
Crr = Range([A2], [A65536].End(3))
For i = 1 To UBound(Crr)
   T = Crr(i, 1)
   Crr(i, 1) = ""
   For x = 1 To UBound(Brr)
      T1 = Trim(Brr(x, 1)): If T1 = "" Then GoTo x01
      If InStr(T, T1) Then
         Crr(i, 1) = IIf(Crr(i, 1) = "", T1, Crr(i, 1) & "、" & T1)
      End If
x01: Next
Next
[C2].Resize(UBound(Crr), 1) = Crr
End Sub

---

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