返回列表 上一主題 發帖

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

回復  abc9gad2016

不好意思,少算1欄,請再測試看看,謝謝
  Sub tt2()
Set xD = CreateObject("Sc ...
samwang 發表於 2021-1-25 17:41



    感謝大大,昨晚用您的程式碼後稍做修改有成功弄成我要的樣子  謝謝
Sub 搜尋()
'
' 搜尋 巨集
' 搜尋
''
Worksheets("尋找").Range("B2:V2").ClearContents
Set xD = CreateObject("Scripting.Dictionary")
Sheets("尋找").[F6:X6] = ""
T = Sheets("尋找").[A2]
xD(T & "") = ""
Arr = Range([工作表1!X6], [工作表1!A65536].End(3))
For i = 2 To UBound(Arr)
    N = xD(Arr(i, 1) & ""): If N = 0 Then GoTo 99
    For J = 6 To 24
        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

本帖最後由 abc9gad2016 於 2021-1-26 09:46 編輯

回復 13# 軒云熊

還是相當感謝大大分享~

TOP

本帖最後由 軒云熊 於 2021-1-25 21:24 編輯

回復 11# abc9gad2016

Public Sub 尋找相對欄位練習()
    Application.ScreenUpdating = False
    Range(Sheets(2).Cells(2, 2).End(xlToRight), Sheets(2).Cells(2, 2)).ClearContents
    Arr = Range(Sheets(1).Cells(Rows.Count, 1).End(xlUp), Sheets(1).Cells(6, 1).End(xlToRight))
    Set xD = CreateObject("Scripting.Dictionary")
   
    For Y = 1 To UBound(Arr, 2)
        xD(Arr(1, Y)) = Y
    Next Y
   
    For X = 3 To UBound(Arr, 1)
        For Y = 6 To UBound(Arr, 2)
            If Arr(X, 1) = [尋找!A2] And Arr(X, Y) <> "" Then
                E = E + 1
                Sheets(2).Cells(2, 1 + E) = Arr(1, xD(Arr(1, Y)))
            End If
        Next Y
    Next X
    Application.ScreenUpdating = True
End Sub

建議 修改 samwang 大大的位置 比較好 他的寫法 比我的好很多

TOP

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

本帖最後由 abc9gad2016 於 2021-1-25 16:34 編輯

回復 2# 軒云熊


   謝大大~測試成功
另外想請教若表格中多了一些無關的資訊,要改由F7:X24這個範圍尋找F6開始的對應值的話
應該要如何修改程式呢 謝謝

TOP

回復  abc9gad2016

請測試看看,謝謝。

Sub tt2()
Set xD = CreateObject("Scripting.Dictionary" ...
samwang 發表於 2021-1-23 10:31


S大不好意思,測試後發現會少列到一項,如圖
因對程式較不熟不清楚要如何修改 謝謝

TOP

回復 7# hcm19522


    感謝大大提供函數的解法 感謝!

TOP

回復 5# samwang

謝謝samwang前輩的回覆 學習了  感謝

TOP

google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

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

        靜思自在 : 為人處世要小心細心,但不要「小心眼」。
返回列表 上一主題