エクセルVBA - 私はここにすでにフィルタリングテーブルを持っている必要セル

Question

で特定の行を見つけるために、フィルタテーブルの列をループ：

私はMintaszamと呼ばれる長い変数を持っています。この例では、正確な値は13です。この行が必要です：AA < = 13（可変）< = AB。これでAJの内容をその行からコピーする必要があります（それは文字列であり、ピクチャにはありません）。別のワークシートにコピーする必要があります。

UPDATE - 私はアイデアを思い付いたのが、コードが動作していないと私はエラーを取得していない：

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