如何自动过滤,偏移和复制值到新工作表Excel VBA

时间:2017-06-09 13:00:15

标签: excel vba excel-vba

致敬致敬!我叫克里斯托弗。

最近我一直在参加一系列excel项目,我想我的脑子已经过热了。如果你们能给我带些凉水,那就非常感激了!

所以我有一张表,我正在使用它作为库存表,它是非交互式和过时的。更不用说我将每个部分的库存信息存储在多行中(图形很好,功能不太好。)

我已经制作了一个新的(更好的)工作簿,所以现在我只想把我的一些旧数据复制到适合我的新单行格式的新工作表(在旧工作簿中)。我将直接复制并将该表中的信息粘贴到我的新改进的工作簿中

我有一些代码,我将在最后发布,我想要做的是:

在我的Sheet1中,我希望AutoFilter在A列中找到第一个文本值“LOC”,然后偏移到B列以获取我的部件的位置。然后它将向下偏移一行以获得零件号。之后,它将向下偏移另外两行以获得描述。

在我的Sheet2中,我想找到第一个空行。然后我希望我在Sheet1中找到的信息存入该空行的A,B和C列。

我希望我非常具体,在我要求帮助的方式上达到更好的效果而不是愚蠢!

在这里,我将发布我的代码,我感谢任何和所有建议,代码调整和帮助!

谢谢!

-Christopher

P.S。当心,你可能会笑。我的编码有时候很可笑。我总是欣赏有关为什么有效,不起作用,或为什么另一件有效的东西在特定情况下会更好的解释!

代码:

    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

1 个答案:

答案 0 :(得分:1)

  

在我的Sheet1中,我希望AutoFilter在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看起来像这样

enter image description here

然后输出将如下所示

enter image description here