返回列表 上一主題 發帖

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

free72921

帖子
8 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
Windows  
軟體版本
7 
閱讀權限
20 
註冊時間
2016-6-1 
最後登錄
2023-10-31 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-4-26 19:07 | 只看該作者

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

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

感謝各位前輩。

分類項目

Image 842.jpg
2020-4-26 19:02

回傳分類

Image 843.jpg
2020-4-26 19:02


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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-15 
3#
發表於 2020-4-27 13:45 | 只看該作者
=LOOKUP(,-FIND(","&A2&",",","&分類表!B$1:B$199&","),分類表!A:A)&""

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-15 
4#
發表於 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

TOP

free72921

帖子
8 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
Windows  
軟體版本
7 
閱讀權限
20 
註冊時間
2016-6-1 
最後登錄
2023-10-31 
5#
發表於 2020-4-29 21:53 | 只看該作者
非常感謝2位版主前輩，受教了。
謝謝

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題