按標題而不是excel字母搜索列

我目前有一個如下所示的代碼，它回圈遍歷 3 個整列并提取任何大于 0 的值。此代碼使用代碼中明確標識的列。在這種情況下，BQ、BT 和 BW。

Option Explicit
Sub ID()
Dim ID0&, ID1&, ID2&, i&

Dim cell As Range
Dim arr(1 To 1000000, 1 To 2)
With Sheets("LOGS here")

    ID0 = .Cells(Rows.Count, "BQ").End(xlUp).Row
    ID1 = .Cells(Rows.Count, "BT").End(xlUp).Row
    ID2 = .Cells(Rows.Count, "BW").End(xlUp).Row
    For Each cell In .Range("BQ2:BQ" & ID0)
        If cell > 0 Then
            i = i   1
            arr(i, 1) = cell 'ID0
            arr(i, 2) = cell.Offset(, 133) 'Time
        End If
    Next
    For Each cell In .Range("BT2:BT" & ID1)
        If cell > 0 Then
            i = i   1
            arr(i, 1) = cell 'ID1
            arr(i, 2) = cell.Offset(, 130) 'Time
        End If
    Next
    For Each cell In .Range("BW2:BW" & ID2)
        If cell > 0 Then
            i = i   1
            arr(i, 1) = cell 'ID2
            arr(i, 2) = cell.Offset(, 127) 'Time
        End If
    Next
End With

Sheets("ID Pull Out").Cells(2, 1).Resize(i, 2).Value = arr

End Sub

但現在我想搜索列標題 ID0、ID1 和 ID2。這是我到目前為止所做的。代碼無法遍歷整個列直到最后一行。我應該在End(xlUp).Row某處添加嗎？

Sub IDNEW()

Dim ID0 As Range
Dim ID1 As Range
Dim ID2 As Range
Dim i
Dim cell As Range
Dim arr(1 To 10000, 1 To 2)

    Set ID0 = Worksheets("LOGS here").Range("A1:GS1").Find("ID0", LookAt:=xlWhole)
    Set ID1 = Worksheets("LOGS here").Range("A1:GS1").Find("ID1", LookAt:=xlWhole)
    Set ID2 = Worksheets("LOGS here").Range("A1:GS1").Find("ID2", LookAt:=xlWhole)

    For Each cell In ID0.Rows
        If cell > 0 Then
            i = i   1
            arr(i, 1) = cell 'ID0
            arr(i, 2) = cell.Offset(, 133) 'Time
        End If
    Next
    
    For Each cell In ID1.Rows
        If cell > 0 Then
            i = i   1
            arr(i, 1) = cell 'ID1
            arr(i, 2) = cell.Offset(, 130) 'Time
        End If
    Next
    
    For Each cell In ID2.Rows
        If cell > 0 Then
            i = i   1
            arr(i, 1) = cell 'ID2
            arr(i, 2) = cell.Offset(, 127) 'Time
        End If
    Next

Sheets("ID Pull Out").Cells(2, 1).Resize(i, 2).Value = arr

End Sub

我仍在學習 VBA，任何幫助將不勝感激。

uj5u.com熱心網友回復：

你可以嘗試這樣的事情：

Sub IDNEW()

    Dim i As Long, n As Long
    Dim cell As Range, ws As Worksheet
    Dim arr(1 To 10000, 1 To 2), arrId, arrOffset, m, v
    
    arrId = Array("ID0", "ID1", "ID2") 'list of id's
    arrOffset = Array(133, 130, 127)   'list of corresponding column offsets
    
    Set ws = Worksheets("LOGS here")
    
    For n = LBound(arrId) To UBound(arrId)                        'loop the id's
        m = Application.match(arrId(n), ws.Range("A1:GS1"), 0)    'match the id on row 1
        If Not IsError(m) Then                                    'if not an error then found a match
            For Each cell In ws.Range(ws.Cells(2, m), ws.Cells(Rows.Count, m).End(xlUp)).Cells
                v = cell.Value
                If v > 0 Then
                    i = i   1
                    arr(i, 1) = v
                    arr(i, 2) = cell.Offset(0, arrOffset(n).Value) 'Time
                End If
            Next cell
        End If
    Next n
    
    Sheets("ID Pull Out").Cells(2, 1).Resize(i, 2).Value = arr

End Sub

標籤：擅长 vba

上一篇：編譯器錯誤：未定義子或函式

下一篇：單擊提交按鈕不回應seleniumv??ba