返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
1# 跳轉到 »
發表於 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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
2#
發表於 2021-1-23 09:36 | 顯示全部帖子
回復 4# 軒云熊


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

TOP

samwang

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
4#
發表於 2021-1-25 17:41 | 顯示全部帖子
回復 10# abc9gad2016

不好意思，少算1欄，請再測試看看，謝謝
  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 20
         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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
5#
發表於 2021-1-26 11:07 | 顯示全部帖子
回復 16# abc9gad2016

請測試看看，謝謝
Sub tt3()
Set xD = CreateObject("Scripting.Dictionary")
Sheets("尋找").[B2].Resize(1, 200) = ""
T = Sheets("尋找").[A2]
xD(T & "") = ""
Arr = Range([工作表1!BR64], [工作表1!A65536].End(3))
For i = 2 To UBound(Arr)
     N = xD(Arr(i, 1) & ""): If N = 0 Then GoTo 99
     For j = 10 To UBound(Arr, 2)
         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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
6#
發表於 2021-1-26 17:39 | 顯示全部帖子
回復 19# abc9gad2016


    Sheets("成品").[L2].Resize(1, 200) = ""  --> 清除上一次查詢資料

For J = 10 To UBound(Arr, 2)
-->因為搜尋範圍為J64:BR64
設定範圍Arr = Range([工作表1!BR64], [工作表1!A65536].End(3))
UBound(Arr, 2) Arr最後一欄 BR

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始，每一個時刻都是自己的警惕。
返回列表 上一主題