Question

我正在尝试使用VBA修改“从我的Excel中删除重复和总和数量”。下面是修改代码..

Sub mcr_Collect_Unique()
Dim ws As Worksheet, wsu As Worksheet
Set ws = ActiveSheet
Set wsu = Sheets.Add(after:=Sheets(Sheets.Count))
ws.Cells(1, 1).CurrentRegion.Copy Destination:=wsu.Cells(1, 1)
With wsu.Cells(1, 1).CurrentRegion
    With .Cells.Resize(.Rows.Count, .Columns.Count)
        .RemoveDuplicates Columns:=Array(1, 1, 2), Header:=xlYes
        Debug.Print Application.Count(wsu.Columns(3))
        With .Cells(2, 3).Resize(Application.Count(wsu.Columns(3)), 1)
            .FormulaR1C1 = "=SUMIFS('" & ws.Name & "'!C,'" & ws.Name & _
              "'!C[-2],RC[-2],'" & ws.Name & "'!C[-2],RC[-2],'" & ws.Name & _
              "'!C[-1],RC[-1])"
            '.Cells = .Value
        End With
    End With
End With
End Sub

该程序运作完美，但结果出现在不同的表格中。我应该如何修改代码，使其在同一张表格中出现？

感谢。

Answer 1

目标单元格是范围（＆＃34; f1＆＃34;）。

Sub mcr_Collect_Unique()
Dim ws As Worksheet, wsu As Worksheet
Dim rngT As Range
Set ws = ActiveSheet
'Set wsu = Sheets.Add(after:=Sheets(Sheets.Count))
'ws.Cells(1, 1).CurrentRegion.Copy Destination:=wsu.Cells(1, 1)
Set rngT = Cells(1, 6)
ws.Cells(1, 1).CurrentRegion.Copy Destination:=rngT
With rngT.CurrentRegion
    With .Cells.Resize(.Rows.Count, .Columns.Count)
        .RemoveDuplicates Columns:=Array(1, 1, 2), Header:=xlYes
        'Debug.Print Application.Count(wsu.Columns(3))
        'With .Cells(2, 3).Resize(Application.Count(wsu.Columns(3)), 1)
        With .Cells(2, 3).Resize(Application.Count(.Columns(3)), 1)
            '.FormulaR1C1 = "=SUMIFS('" & ws.Name & "'!C,'" & ws.Name & _
              "'!C[-2],RC[-2],'" & ws.Name & "'!C[-2],RC[-2],'" & ws.Name & _
              "'!C[-1],RC[-1])"
              .FormulaR1C1 = "=SUMIFS('" & ws.Name & "'!C3,'" & ws.Name & _
              "'!C1,RC[-2],'" & ws.Name & _
              "'!C2,RC[-1])"
            '.Cells = .Value
        End With
    End With
End With
End Sub

如果您需要相同的工作表和相同的单元格，请参阅此页。

Sub test()
    Dim Ws As Worksheet
    Dim rngDB As Range, vDB, vR()
    Dim X As New Collection
    Dim Wf As WorksheetFunction
    Dim i As Long, n As Long, r As Long
    Dim s As String, s1 As String

    Set Wf = WorksheetFunction
    Set X = New Collection

    Set Ws = ActiveSheet
    Set rngDB = Ws.Range("a1").CurrentRegion

    vDB = rngDB
    r = UBound(vDB, 1)
    For i = 2 To r
        On Error Resume Next
        X.Add vDB(i, 1) & "," & vDB(i, 2), vDB(i, 1) & "," & vDB(i, 2)
    Next i
    For i = 1 To X.Count
        n = n + 1
        s = Split(X.Item(i), ",")(0)
        s1 = Split(X.Item(i), ",")(1)
        ReDim Preserve vR(1 To 3, 1 To n)
        vR(1, n) = s
        vR(2, n) = s1
        With rngDB
            vR(3, n) = Wf.SumIfs(.Columns(3), .Columns(1), s, .Columns(2), s1)
        End With
    Next i
    With Ws
        .Range("a1").CurrentRegion.Offset(1).Clear
        .Range("a2").Resize(n, 3) = Wf.Transpose(vR)
    End With
End Sub

Excel - 同时删除重复和SUM数量

1 个答案: