Question

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

我有一个名为Mintaszam的Long变量。在这个例子中，它的确切值是13.我需要这一行：AA＆lt; = 13（变量）＆lt; = AB。现在我有了确切的行（第二行），我需要将AJ的内容从该行复制（它是一个字符串而不在图片上）到另一个工作表。

更新 - 我提出了一个想法，但代码无效，我没有错误：

@[User::FileType] == "Excel"

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

Excel VBA - 循环遍历筛选表的列以查找具有所需单元格的特定行

1 个答案: