Excel VBA – 循环遍历已过滤的表的列，以find具有所需单元格的特定行

我有一个已经过滤的表格在这里：

我有一个叫做Mintaszam的Longvariables。 在这个例子中，它的确切值是13.我需要这一行：AA <= 13（variables）<= AB。 现在，我有确切的行（第二个），我需要从该行（这是一个string，它不在图片上）的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 

Answer 1

好吧，我已经知道了一切。 这工作：

 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