Question

我有多个工作表：

1) Agent Sales
Name | Product | Sales
A | XX | $100
B | XX | $200
C | YY | $150
A | YY | $400


2) Agent Expense
Name | Product | Expense
A | XX | $10
B | XX | $20
C | YY | $15
A | YY | $80

我们的想法是在每个代理的单独工作表上创建一个报告，将它们与每个产品的其他代理进行比较。例如，代理A：

>     Sales
>     Name | Product | Sales
>     A | XX | $100
>     B | XX | $200
>     
>     Expense
>     Name | Product | Sales
>     A | XX | $10
>     B | XX | $10
>     
>     
>     Sales
>     Name | Product | Sales
>     A | YY | $400
>     C | YY | $150
>     
>     Expense
>     Name | Product | Sales
>     A | YY | $80
>     C | YY | $15

我只是想学习VBA，我解决问题的第一步是使用自动过滤功能来复制和粘贴功能。到目前为止，这是我的代码：子测试（）

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sales")
ws.Rows(1).AutoFilter Field:=1, Criteria1:="A"
ws.Rows(1).AutoFilter Field:=2, Criteria1:="XX"
ws.Range("A2:C2", Range("A2:C2").End(xlDown)).Copy
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial

Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("Expense")
ws2.Rows(1).AutoFilter Field:=1, Criteria1:="A"
ws2.Rows(1).AutoFilter Field:=2, Criteria1:="XX"
ws2.Range("A2:C2", Range("A2:C2").End(xlDown)).Copy
ThisWorkbook.Worksheets("Sheet2").Range("H1").PasteSpecial

End Sub

它返回了运行时错误1004 - 对象范围的方法失败。

但是，如果我只复制粘贴销售表，则代码可以正常工作。

我看到VBA可能会删除剪贴板上的数据的帖子，但鉴于销售表已成功粘贴，我不确定为什么第二个会发出错误。

感谢所有帮助/想法。

Answer 1

在以下代码行中：

Range

ws2.Range("A2:C2", ws2.Range("A2:C2").End(xlDown)).Copy缺少工作表参考，您需要添加 ws2 ，如下所示：

Sub TestCopyPaste()

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sales")

ws.Rows(1).AutoFilter Field:=1, Criteria1:="A"
ws.Rows(1).AutoFilter Field:=2, Criteria1:="XX"
ws.Range("A2:C2", ws.Range("A2:C2").End(xlDown)).Copy
ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial

Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("Expense")

ws2.Rows(1).AutoFilter Field:=1, Criteria1:="A"
ws2.Rows(1).AutoFilter Field:=2, Criteria1:="XX"
ws2.Range("A2:C2", ws2.Range("A2:C2").End(xlDown)).Copy
ThisWorkbook.Worksheets("Sheet2").Range("H1").PasteSpecial

End Sub

复制下面的完整代码，您不会收到任何错误（在我的电脑上使用您上传的样本数据进行测试）

let view = UIView(frame: CGRectMake((contentView.frame.size.width-100)/2,(contentView.frame.size.height-100)/2,100,100))
    view.backgroundColor = UIColor.blueColor()
    contentView.backgroundColor = UIColor.redColor()
    contentView.addSubview(view)

Answer 2

我评论了Field:=1过滤器，因为您尝试按产品分组而不是名称和产品。

Sub TestCopyPaste()
    Dim NextRow As Long, x As Long
    Dim Name As String, Product As String
    Dim dict As Object

    Set dict = CreateObject("Scripting.Dictionary")

    Dim ExpenseRange As Range

    Worksheets("Report").Cells.Clear

    For x = 2 To Worksheets("Sales").Range("A" & Rows.Count).End(xlUp).Row
        Name = Worksheets("Sales").Cells(x, 1)
        Product = Worksheets("Sales").Cells(x, 2)

        If Not dict.Exists(Product) Then
            NextRow = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row
            If NextRow > 1 Then NextRow = NextRow + 2

            getFilteredData(Worksheets("Sales"), Name, Product).Copy Worksheets("Report").Cells(NextRow, 1)

            Set ExpenseRange = getFilteredData(Worksheets("Expense"), Name, Product)

            If Not ExpenseRange Is Nothing Then
                NextRow = Worksheets("Report").Range("A" & Rows.Count).End(xlUp).Row + 2
                ExpenseRange.Copy Worksheets("Report").Cells(NextRow, 1)
            End If

            dict.Add Product, vbNullString
        End If
    Next

    Worksheets("Report").Columns.AutoFit

End Sub

Function getFilteredData(ws As Worksheet, Name As String, Product As String)
     With ws
        '.Rows(1).AutoFilter Field:=1, Criteria1:=Name
        .Rows(1).AutoFilter Field:=2, Criteria1:=Product
        Set getFilteredData = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    End With
End Function

VBA宏 - 根据引用表上的值复制粘贴多个工作表

2 个答案: