[發問] 搜尋代號後，尋找對應列數的儲存格

想請教版上前輩

如希望能在"尋找sheet"中，查詢工作表1中的任一個代號

查詢後:往右搜尋到有數字的儲存格，再去對應的第二列查所屬的編號

舉例:尋找GV8CX3Y00，往右搜尋會發現在N、R、S欄位有數字
對應到所屬的第二列為MM、QQ、RR

想請教前輩有沒有函數或VBA有辦法執行這樣的結果(抓出某代號第二列對應的編號)
因代號欄跟編號列會到上千項，手動查詢已經快無法負荷感謝

函數唯一想到的只有IF，搜尋<>""，但抓到後要如何使之對應到第三列
是卡關的步驟

搜尋範例.rar (151.65 KB)

樓主熱帖

軒云熊

中學生 Rank: 2

帖子: 254
主題: 6
精華: 0
積分: 310
點名: 0
作業系統: W10
軟體版本: Excel 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-6-16
最後登錄: 2025-6-21

2^#

發表於 2021-1-22 21:20 | 只看該作者

回復 1# abc9gad2016
這是參考 jcchiang 大大的寫法有空看看是不是這樣感謝

Public Sub 尋找相對欄位練習()
Arr = [工作表1!A1].CurrentRegion
Set xD = CreateObject("Scripting.Dictionary")
For Y = 1 To UBound(Arr, 2)
xD(Arr(2, Y)) = Y
Next Y
For X = 3 To UBound(Arr, 1)
For Y = 2 To UBound(Arr, 2)
If Arr(X, 1) = [尋找!A2] And Arr(X, Y) <> "" Then
E = E + 1
Sheets(2).Cells(2, 1 + E) = Arr(2, xD(Arr(2, Y)))
End If
Next Y
Next X
End Sub

複製代碼

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

3^#

發表於 2021-1-22 23:27 | 只看該作者

回復 1# abc9gad2016

請測試看看，感謝。

Sub tt()
Set xD = CreateObject("Scripting.Dictionary")
T = Sheets("尋找").[A2]
xD(T & "") = ""
Arr = Range([工作表1!T2], [工作表1!A65536].End(3))
For i = 2 To UBound(Arr)
If xD.Exists(Arr(i, 1) & "") Then
      For j = 2 To 19
         If Arr(i, j) <> "" Then: M = M + 1: Arr(1, M) = Arr(1, j)
      Next
End If
Next
If M > 0 Then Sheets("尋找").[B2].Resize(1, M) = Arr
End Sub

TOP

軒云熊

中學生 Rank: 2

帖子: 254
主題: 6
精華: 0
積分: 310
點名: 0
作業系統: W10
軟體版本: Excel 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-6-16
最後登錄: 2025-6-21

4^#

發表於 2021-1-23 01:32 | 只看該作者

回復 3# samwang

感謝 samwang 前輩的指導小弟受益良多請問 samwang前輩 T & "" 為甚麼要串連空白 & "" 的用意是甚麼
可否說明一下我不太理解因為字典不是那麼直觀

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

5^#

發表於 2021-1-23 09:36 | 只看該作者

回復 4# 軒云熊

看了准大版主常使用此方法，字典加入""字串，可以加快執行速度
如有不對請各位前賢指教，感謝。

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

6^#

發表於 2021-1-23 10:31 | 只看該作者

回復 1# abc9gad2016

請測試看看，謝謝。

Sub tt2()
Set xD = CreateObject("Scripting.Dictionary")
Sheets("尋找").[B2:T2] = ""
T = Sheets("尋找").[A2]
xD(T & "") = ""
Arr = Range([工作表1!T2], [工作表1!A65536].End(3))
For i = 2 To UBound(Arr)
N = xD(Arr(i, 1) & ""): If N = 0 Then GoTo 99
For j = 2 To 19
If Arr(i, j) <> "" Then: M = M + 1: Arr(1, M) = Arr(1, j)
Next
99: Next
If M > 0 Then Sheets("尋找").[B2].Resize(1, M) = Arr
End Sub

TOP

hcm19522