Question

我有一张需要根据某些条件进行过滤的工作表，然后将第一列值/和列AT复制到另一张工作表。第一张（Sheet1）包含多行（但我们只需要使用A和AT列）因此，如果AT列包含“N / A”或空值......那么我们需要将A列和AT值复制到Sheet2。我正在编写如下的VBA代码，并在YDest工作表中进行过滤，我需要过滤数据并在Ydest上放入另一张“Missing Info”

Private Sub Grab_Click()
    Dim xSource As Workbook
    Dim yDest As Workbook
    '## Open both workbooks first:

    Set xSource = Workbooks.Open("Vendor Dispatch new.xlsx")
    Set yDest = Workbooks.Open("Vendor DisPatch Standard.xlsm")

    With xSource.Sheets("Vendor Dispatch new").UsedRange
        'Now, paste to y worksheet:
        yDest.Sheets("Vendor Dispatch new").Range("A2").Resize( _
            .Rows.Count, .Columns.Count) = .Value
        yDest.Sheets("Vendor Dispatch new").Range("A2").WrapText = True
    End With
    yDest.Sheets("Vendor Dispatch new").Rows("2:4").Delete
    'y.Sheets("Vendor Dispatch new").Range("1:1").EntireRow.Interior.Color = 1280
    'Filter Data with copy into MissingInfoSheet
    xSource.Close
    yDest.Save
    yDest.Close
End Sub

Answer 1

试试这个。这是一种使用变体数组的方法。

Sub test()
    Dim Ws As Worksheet, toWs As Worksheet
    Dim vDB, vR()
    Dim xSource As Workbook
    Dim yDest As Workbook
    Dim i As Long, n As Long, c As Integer, j As Integer
    '## Open both workbooks first:

    Set xSource = Workbooks.Open("Vendor Dispatch new.xlsx")
    Set yDest = Workbooks.Open("Vendor DisPatch Standard.xlsm")

    Set Ws = xSource.Sheets("Vendor Dispatch new")
    Set toWs = yDest.Sheets("Vendor Dispatch new")

    With Ws
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        vDB = .Range("a1", .Cells(r, c))
        For i = 1 To r
            If IsError(vDB(i, 46)) Then
                n = n + 1
                ReDim Preserve vR(1 To c, 1 To n)
                For j = 1 To c
                    vR(j, n) = vDB(i, j)
                Next j
            Else
                If vDB(i, 46) = "" Then
                    n = n + 1
                    ReDim Preserve vR(1 To c, 1 To n)
                    For j = 1 To c
                        vR(j, n) = vDB(i, j)
                    Next j
                End If
            End If
        Next i
    End With
    With toWs
        .Cells.Clear
        .Range("a2").Resize(n, c) = WorksheetFunction.Transpose(vR)
    End With
    xSource.Close
    yDest.Save
    yDest.Close
End Sub

VBA在条件上过滤和复制数据

1 个答案: