標題: [發問] 多儲存格尋找特定條件 [打印本頁]

---

作者: free72921    時間: 2020-4-26 19:07     標題: 多儲存格尋找特定條件

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

感謝各位前輩。

[attach]31957[/attach]
[attach]31958[/attach]

[attach]31959[/attach]

---

作者: GBKEE    時間: 2020-4-27 12:57

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

複製代碼

---

作者: 准提部林    時間: 2020-4-27 13:45

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

---

作者: 准提部林    時間: 2020-4-28 10:53

本帖最後由 准提部林 於 2020-4-28 10:54 編輯

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    時間: 2020-4-29 21:53

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

---

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