如何自動過濾，偏移和將值復制到新工作表Excel VBA

Question

問候bretheren！ 我叫克里斯托弗。

最近，我一直在進行一系列的excel項目，我認為我的大腦已經過熱了。 如果你們能給我帶來一些涼水，不勝感激！

因此，我有一個被用作庫存表的表，它是非交互的且過時。 更不用說我要在多行中存儲每個零件的庫存信息（在圖形上不錯，不是很實用）。

我已經制作了一個新的（更好的）工作簿，所以現在我只想獲取一些舊數據並將其復制到一個適合我的新單行格式的新工作表中（在舊工作簿中）。 我將直接將工作表中的信息復制並粘貼到新的和改進的工作簿中

我有一些代碼將在結尾處發布，而我試圖做到的是這樣的：

在我的Sheet1中，我希望自動篩選器在A列中找到第一個文本值“ LOC”，然后偏移到B列以獲得我零件的位置。 然后它將向下偏移一行以獲得零件號。 之后，它將向下偏移另外兩行以獲取描述。

在我的Sheet2中，我想找到第一個空行。 然后，我希望將在Sheet1中找到的信息存儲到該空行的A，B和C列中。

我希望我已經很具體了，以達到更好的效果，而且我要求援助的方式也並不傻！

在這里，我將發布我的代碼，感謝所有建議，代碼調整和幫助！

謝謝！

-克里斯托弗

PS當心，您可能會笑。 我的編碼有時可笑。 我總是很欣賞關於為什么某些東西行得通，什么行不通或者為什么另一種行之有效的方法在特定情況下會更好的解釋！

碼：

    Sub CopyStuff()

    Dim iRow As Long
    Dim ws As Worksheet
    Dim Loc
    Dim Part
    Dim Desc

    Set ws = Worksheets("Sheet2")
    iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

    With Sheets("Sheet2")

        Set Part = iRow.Offset(0, 0)
        Set Loc = iRow.Offset(0, 1)
        Set Desc = iRow.Offset(0, 2)

    End With

    With Sheets("Sheet1")
        .AutoFilter 1, "LOC"
        .Offset(0, 1).Copy Loc
        .Offset(1, 0).Copy Part
        .Offset(2, 0).Copy Desc
        .AutoFilter
    End With

    End Sub

Answer 1

在我的Sheet1中，我希望自動篩選器在A列中找到第一個文本值“ LOC”，然后偏移到B列以獲得我零件的位置。 然后它將向下偏移一行以獲得零件號。

您不需要自動過濾器，因為您必須從多行中檢索值。 使用.Find代替

Sub CopyStuff()
    Dim wsIRow As Long, wsORow As Long
    Dim wsI As Worksheet, wsO As Worksheet
    Dim rng As Range, aCell As Range

    Set wsI = Worksheets("Sheet1")
    Set wsO = Worksheets("Sheet2")

    wsORow = wsO.Cells.Find(What:="*", SearchOrder:=xlRows, _
             SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

    With wsI
        wsIRow = wsI.Cells.Find(What:="*", SearchOrder:=xlRows, _
                 SearchDirection:=xlPrevious, LookIn:=xlValues).Row

        Set rng = .Range("A1:A" & wsIRow)

        With rng
            Set aCell = .Find(What:="LOC", LookIn:=xlValues, _
                        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)

            If Not aCell Is Nothing Then
                wsO.Range("A" & wsORow).Value = aCell.Value
                wsO.Range("B" & wsORow).Value = aCell.Offset(, 1).Value
                wsO.Range("C" & wsORow).Value = aCell.Offset(1, 1).Value
            End If
        End With
    End With
End Sub

假設Sheet1看起來像這樣

然后輸出將如下所示