Question

我对VBA非常陌生，希望得到一个项目的澄清。我尝试用公式解决它，但我仍然需要能够将信息输入到单元格中，而不是让它们填充查找公式。

我在寻找预制件的方法是，如果一个物品要求它发货，那么序列号和标识符会自动复制并粘贴到另一个空白行的另一个表格中。

信息分为两个表

我认为我需要的是VBA中的一段如下：

    Sub CopyCat()

    If Range("J2") Like "*yes*" then
       Range("G2:I2").copy
       Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues

    If Range("J3") Like "*yes*" then
      Range("G3:I3").copy
      Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues

    End If
    End If
    End Sub

当它只是第一个语句时，它正是我要求它做的事情，当我添加第二个来检查下一行是否满足条件时它是如此，然后它将它放在与之相同的结果单元格中第一个声明。如果两者都是真的，我需要它们都显示在表1中。

我喜欢把它当作一个学习机会，所以你可以指出我的任何信息或方向都会很棒！非常感谢你！

Answer 1

我认为Range("A2:A10").end(xlup)等同于Range("A2").end(xlup)所以不会改变，但你不想要A2参考，你想从底部开始工作。如果你超越A9，你会遇到问题。（另外不确定你想要嵌套的Ifs。）

If Range("J2") Like "*yes*" Then
    Range("G2:I2").Copy
    Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
If Range("J3") Like "*yes*" Then
    Range("G3:I3").Copy
    Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If

或者要添加循环并绕过复制/粘贴，您可以使用以下内容：

Sub CopyCat()

Dim r As Long

For r = 2 To Range("J" & Rows.Count).End(xlUp).Row
    If Range("J" & r) Like "*yes*" Then
        Range("A10").End(xlUp).Offset(1).Resize(, 3).Value = Range("G" & r).Resize(, 3).Value
    End If
Next r

End Sub

Answer 2

您也可以在没有VBA的情况下执行此操作。

在A2中，您可以使用此公式作为数组公式输入 CTRL + SHIFT + ENTER ：

=INDEX($G$2:$G$4,SMALL(IF($J$2:$J$4="yes",ROW($J$2:$J$4)-ROW($J$2)+1),ROWS(J$2:J2)))

在B2中，您可以将其放在B2:D3上并向下拖动：

=INDEX(H$2:H$4,MATCH($A2,$G$2:$G$4,0))

最后，要隐藏在没有更多匹配项时显示的错误，您可以在IFERROR([formula above],"")中简单地包含上述两个公式。

Answer 3

使用自动过滤器

Sub copyRange()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim filterRange As Range

    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("Sheet2")       'change to sheet name containing delivery info

    With wsSource

        lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        Set filterRange = .Range("G1:K" & lastRow)
        Dim copyRange As Range
        Set copyRange = .Range("G2:K" & lastRow)
    End With

    Dim lastRowTarget As Long, nextTargetRow As Long

    With filterRange

        .AutoFilter

        .AutoFilter Field:=4, Criteria1:="yes"     'change field to whichever is the field in the range containing your company names

        lastRowTarget = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

        nextRowTarget = lastRowTarget + 1

        Union(wsSource.Range("G2:I" & lastRow).SpecialCells(xlCellTypeVisible), wsSource.Range("K2:K" & lastRow).SpecialCells(xlCellTypeVisible)).Copy wsSource.Range("A" & nextRowTarget)

        .AutoFilter

    End With

End Sub

当两个或多个条件满足下一个空单元

3 个答案: