123
返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-5-16 
5# 跳轉到 »
發表於 2021-1-23 09:36 | 只看該作者
回復 4# 軒云熊


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

TOP

軒云熊

帖子
253 
主題
5 
精華
0 
積分
308 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-5-15 
4#
發表於 2021-1-23 01:32 | 只看該作者
回復 3# samwang


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

TOP

samwang

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

軒云熊

帖子
253 
主題
5 
精華
0 
積分
308 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-5-15 
2#
發表於 2021-1-22 21:20 | 只看該作者
回復 1# abc9gad2016
這是參考  jcchiang 大大的寫法 有空看看是不是這樣 感謝
  1. Public Sub 尋找相對欄位練習()

  3.     Arr = [工作表1!A1].CurrentRegion
  4.     Set xD = CreateObject("Scripting.Dictionary")
  5.    
  6.     For Y = 1 To UBound(Arr, 2)
  7.         xD(Arr(2, Y)) = Y
  8.     Next Y
  9.    
  10.     For X = 3 To UBound(Arr, 1)
  11.         For Y = 2 To UBound(Arr, 2)
  12.             If Arr(X, 1) = [尋找!A2] And Arr(X, Y) <> "" Then
  13.                 E = E + 1
  14.                 Sheets(2).Cells(2, 1 + E) = Arr(2, xD(Arr(2, Y)))
  15.             End If
  16.         Next Y
  17.     Next X

  19. End Sub
複製代碼

TOP

        靜思自在 : 謊言像一朵盛開的鮮花，外表美麗，生命短暫。
123
返回列表 上一主題