返回列表 上一主題 發帖

B欄要取出符合D欄內的關鍵字

B欄要取出符合D欄內的關鍵字

B欄要取出符合D欄內的關鍵字,請問如何設定公式,謝謝。

B欄要取出符合D欄內的關鍵字.zip (22 Bytes)

joyce

回復 1# leiru


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

TOP

回復 2# samwang


    謝謝告知,附上檔案

B欄要取出符合D欄內的關鍵字.zip (6.7 KB)

joyce

TOP

回復 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

TOP

google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

回復 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

但沒顯示出希望結果

B欄要取出符合D欄內的關鍵字.zip (8.07 KB)

joyce

TOP

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

回復 6# leiru


   已成區域陣列  B2:B7先一起刪 B2重新 在右拉 下拉
  A5 多個 3
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

如果excel版本沒有TEXTJOIN函數, 用vba寫個類似的自訂函數:
Xl0000808.rar (11.15 KB)

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

TOP

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


執行結果:


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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題