[發問] 多儲存格尋找特定條件

free72921

請問各位前輩如何在工作頁中輸入『物品』後回傳分類表中的分類項目，

感謝各位前輩。

下載 (51.82 KB)
分類項目

2020-4-26 19:02

下載 (52.15 KB)
回傳分類

2020-4-26 19:02

多儲存格尋找特定條件.zip (6.9 KB)

下載次數: 20

2020-4-26 19:05

GBKEE

回復 1# free72921
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim AR As Variant, i As Integer, E As Variant
   
4.     With Sheets("分類表")
   
5.         i = 2  '第二列開始
   
6.         Do While .Cells(i, "A") <> ""   '執行一直到沒資料
   
7.             AR = AR & IIf(AR <> "", vbLf, "") & .Cells(i, "A") & "," & .Cells(i, "B") '  接合  分類"," 物品
   
8.             '**讀取物品資料   vbLf  燦列     '**AR的型態為自串
   
9.             i = i + 1   '下一列
   
10.         Loop
    
11.         If AR <> "" Then AR = Split(AR, vbLf)    '將型態為自串 轉為陣列
    
12.     End With
    
13.     With Sheets("工作頁")
    
14.         i = 2
    
15.         Do While .Cells(i, "A") <> ""
    
16.              For Each E In AR            '陣列 的每一元素
    
17.                 If InStr(E, .Cells(i, "A")) Then    'InStr 比對元素中是否有指定的物品
    
18.                     .Cells(i, "B") = Mid(E, 1, InStr(E, ",") - 1)  '寫入分類
    
19.                     Exit For
    
20.                 End If
    
21.             Next
    
22.             i = i + 1
    
23.         Loop
    
24.     End With
    
25. End Sub

複製代碼

准提部林

=LOOKUP(,-FIND(","&A2&",",","&分類表!B$1:B$199&","),分類表!A:A)&""

准提部林

Sub TEST()
Dim Arr, A, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([分類表!A1], [分類表!B65536].End(xlUp))
For i = 2 To UBound(Arr)
    For Each A In Split(Arr(i, 2), ","): xD(A & "") = Arr(i, 1): Next
Next i
With Range([工作頁!B2], [工作頁!A65536].End(xlUp))
     Arr = .Cells.Value
     For i = 1 To UBound(Arr): Arr(i, 1) = xD(Arr(i, 1) & ""): Next
     .Columns(2).Value = Arr
End With
End Sub

free72921

非常感謝2位版主前輩，受教了。
謝謝