Excel的VBA - 通過過濾表中的列循環，從而找到需要的細胞

特定行我有一個已經過濾表中的位置： Excel的VBA - 通過過濾表中的列循環，從而找到需要的細胞

我有一個名爲Mintaszam一個長變量。在這個例子中，它的確切值是13.我需要這一行：AA < = 13（變量）< = AB。現在我有了確切的一行（第二行），我需要將AJ的內容從該行（它是一個字符串，它不在圖片上）複製到另一個工作表中。

更新 - 我想出了一個主意，但代碼不工作，我沒有得到任何錯誤：

Sub leirasok_kozetkodokhoz_D_oszlop() 

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 
Application.EnableEvents = False 

Dim i As Long 
For i = 1 To 46543 

DoEvents 

Dim Azonosito As Long 
Dim lastRow As Long 
Dim Reteg As Long 
Dim Mintaszam As Long 
'Dim B As Long 
Dim D As Long 
'Dim F As Long 
Dim Reteg_leiras As String 

Sheets("MINTA").Activate 
'B = Range("B1").Offset(i, 0) 
D = Range("D1").Offset(i, 0) 
'F = Range("F1").Offset(i, 0) 
If D > 0 And IsEmpty(Range("D1").Offset(i, 1)) Then 
    Azonosito = Range("U1").Offset(i, 0) 
    Reteg = Range("Y1").Offset(i, 0) 
    Mintaszam = Range("X1").Offset(i, 0) 
    Sheets("egyesitett").Activate 
    With Sheets("egyesitett").ListObjects("_1").Range 
     .AutoFilter Field:=23, Criteria1:=Azonosito 
     .AutoFilter Field:=25, Criteria1:=Reteg 
     lastRow = .SpecialCells(xlCellTypeVisible).Rows.Count - 1 
    End With 
    If lastRow > 0 Then 
      Dim tbl As ListObject 
      Dim rngTable As Range 
      Dim rngArea As Range 
      Dim rngRow As Range 

      Set tbl = ActiveSheet.ListObjects("_1") 
      Set rngTable = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible) 

      For Each rngArea In rngTable.Areas 

       For Each rngRow In rngArea.Rows 
        'something is wrong here... 
        If Mintaszam >= rngRow.Cells(26) And Mintaszam <= rngRow.Cells(27) Then 
        Reteg_leiras = rngRow.Cells(35) 
        Sheets("MINTA").Activate 
        Range("D1").Offset(i, 1) = Reteg_leiras 
        End If 
       Next 
      Next 
    End If 
End If 

Next i 

Application.Calculation = xlCalculationAuto 
Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub

來源

2017-02-09 Martin

把斷點放在'Reteg_leiras = rngRow.Cells（35）'上。然後運行代碼並讓我們知道是否觸發了斷點。 – dev1998

首先，在我新創建的工作簿單元格AJ中是第36列。然後，不會簡單查找（或者二進制搜索，如果文件很大）並且複製就足夠了嗎？在使用過濾表格時，準確的單元格選擇可能會令人費解，查找應該無論如何都能正常工作。 – BenDot

謝謝@BenDot。 AJ確實是第36列。我需要使用兩個單獨的工作表並檢查很多變量（鑽孔ID，圖層編號，樣本編號等），然後複製幾千個單元 - 我認爲用簡單的查找是不可能的。 – Martin

好吧，我已經想通了一切。這個作品：

Sub leirasok_kozetkodokhoz_D_oszlop() 

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 
Application.EnableEvents = False 

Dim i As Long 
For i = 1 To 46543 

DoEvents 

Dim Azonosito As Long 
Dim lastRow As Long 
Dim Reteg As Long 
Dim Mintaszam As Long 
'Dim B As Long 
Dim D As Long 
'Dim F As Long 
Dim Reteg_leiras As String 

Sheets("MINTA").Activate 
'B = Range("B1").Offset(i, 0) 
D = Range("D1").Offset(i, 0) 
'F = Range("F1").Offset(i, 0) 
If D > 0 And IsEmpty(Range("D1").Offset(i, 1)) Then 
    Azonosito = Range("U1").Offset(i, 0) 
    Reteg = Range("Y1").Offset(i, 0) 
    Mintaszam = Range("X1").Offset(i, 0) 
    Sheets("egyesitett").Activate 
    With Sheets("egyesitett").ListObjects("_1").Range 
     .AutoFilter Field:=23, Criteria1:=Azonosito 
     .AutoFilter Field:=25, Criteria1:=Reteg 
     lastRow = .SpecialCells(xlCellTypeVisible).Rows.Count 
    End With 
    If lastRow > 0 Then 
     If Reteg > 0 Then 
      Dim tbl As ListObject 
      Dim rngTable As Range 
      Dim rngArea As Range 
      Dim rngRow As Range 

      Set tbl = ActiveSheet.ListObjects("_1") 
      Set rngTable = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible) 

      For Each rngArea In rngTable.Areas 

       For Each rngRow In rngArea.Rows 
        If Mintaszam >= rngRow.Cells(27) And Mintaszam <= rngRow.Cells(28) Then 
        Reteg_leiras = rngRow.Cells(36) 
        Sheets("MINTA").Activate 
        Range("D1").Offset(i, 1) = Reteg_leiras 
        End If 
       Next 
      Next 
     Else 
     Sheets("MINTA").Activate 
     Range("D1").Offset(i, 1) = 111 
     End If 
    End If 
End If 

Next i 

Application.Calculation = xlCalculationAuto 
Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub

來源

2017-02-09 15:30:36 Martin

Excel的VBA - 通過過濾表中的列循環，從而找到需要的細胞

回答

相關問題