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 - 通过过滤表中的列循环，从而找到需要的细胞

回答

相关问题