按结算时间“2024-5-1”，放单子用户姓名和接单用户合计，等于放单价-接单价

酸茄子

各位老师好！现在有如下左边的数据源，需要生成右边的统计表格。想学习一下各位老师用VBA都有什么思路解决。
在此先感谢各位老师的围观解答。

ringo777

字典呗      

逐渐陌生

=HSTACK(PIVOTBY(I1:I22,L1:L22,C1:C22,SUM,,,,0),DROP(PIVOTBY(I1:I22,F1:F22,D1:D22,SUM,,,,0),,1))

酸茄子

Sub GenerateNewStatistics()     Dim ws As Worksheet     Dim lastRow As Long     Dim i As Long     Dim newWs As Worksheet      Set ws = Sheets("Sheet0")      '将 C 列和 D 列的文本处理为数值     lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row     For i = 1 To lastRow         ws.Cells(i, 3).Value = Val(ws.Cells(i, 3).Value)         ws.Cells(i, 4).Value = Val(ws.Cells(i, 4).Value)     Next i      '处理 I 列的时间格式     lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row     For i = 2 To lastRow         Dim originalTime As String         originalTime = ws.Cells(i, 9).Value         Dim newTime As String         newTime = Left(originalTime, 10)         ws.Cells(i, 9).Value = newTime     Next i      '创建新的工作表用于统计     Set newWs = Worksheets.Add      '计算相同放单用户姓名的放单价合计     Dim userNames As Object     Set userNames = CreateObject("Scripting.Dictionary")      lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row     For i = 2 To lastRow         Dim userName As String         userName = ws.Cells(i, 1).Value         Dim settlementTime As String         settlementTime = ws.Cells(i, 9).Value         If settlementTime = "2024-5-1" Then             If Not userNames.Exists(userName) Then                 userNames.Add userName, 0             End If             userNames(userName) = userNames(userName) + ws.Cells(i, 3).Value         End If     Next i      '在新工作表中输出放单用户姓名和放单价合计     newWs.Cells(1, 1).Value = "放单用户姓名"     newWs.Cells(1, 2).Value = "放单价合计"     i = 2     For Each Key In userNames.Keys         newWs.Cells(i, 1).Value = Key         newWs.Cells(i, 2).Value = userNames(Key)         i = i + 1     Next      '计算接单用户合计     Dim receivingUserNames As Object     Set receivingUserNames = CreateObject("Scripting.Dictionary")      For i = 2 To lastRow         Dim receivingUserName As String         receivingUserName = ws.Cells(i, 2).Value         Dim settlementTime As String         settlementTime = ws.Cells(i, 9).Value         If settlementTime = "2024-5-1" Then             If Not receivingUserNames.Exists(receivingUserName) Then                 receivingUserNames.Add receivingUserName, 0             End If             receivingUserNames(receivingUserName) = receivingUserNames(receivingUserName) + (ws.Cells(i, 3).Value - ws.Cells(i, 4).Value)         End If     Next i      '在新工作表中输出接单用户姓名和接单用户合计     newWs.Cells(1, 4).Value = "接单用户姓名"     newWs.Cells(1, 5).Value = "接单用户合计"     i = 2     For Each Key In receivingUserNames.Keys         newWs.Cells(i, 4).Value = Key         newWs.Cells(i, 5).Value = receivingUserNames(Key)         i = i + 1     Next End Sub

酸茄子

Sub GenerateNewStatistics()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim newWs As Worksheet

    Set ws = Sheets("Sheet0")

    '将 C 列和 D 列的文本处理为数值
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    For i = 1 To lastRow
        ws.Cells(i, 3).Value = Val(ws.Cells(i, 3).Value)
        ws.Cells(i, 4).Value = Val(ws.Cells(i, 4).Value)
    Next i

    '处理 I 列的时间格式
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    For i = 2 To lastRow
        Dim originalTime As String
        originalTime = ws.Cells(i, 9).Value
        Dim newTime As String
        newTime = Left(originalTime, 10)
        ws.Cells(i, 9).Value = newTime
    Next i

    '创建新的工作表用于统计
    Set newWs = Worksheets.Add

    '计算相同放单用户姓名的放单价合计
    Dim userNames As Object
    Set userNames = CreateObject("Scripting.Dictionary")

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        Dim userName As String
        userName = ws.Cells(i, 1).Value
        Dim settlementTime As String
        settlementTime = ws.Cells(i, 9).Value
        If settlementTime = "2024-5-1" Then
            If Not userNames.Exists(userName) Then
                userNames.Add userName, 0
            End If
            userNames(userName) = userNames(userName) + ws.Cells(i, 3).Value
        End If
    Next i

    '在新工作表中输出放单用户姓名和放单价合计
    newWs.Cells(1, 1).Value = "放单用户姓名"
    newWs.Cells(1, 2).Value = "放单价合计"
    i = 2
    For Each Key In userNames.Keys
        newWs.Cells(i, 1).Value = Key
        newWs.Cells(i, 2).Value = userNames(Key)
        i = i + 1
    Next

    '计算接单用户合计
    Dim receivingUserNames As Object
    Set receivingUserNames = CreateObject("Scripting.Dictionary")

    For i = 2 To lastRow
        Dim receivingUserName As String
        receivingUserName = ws.Cells(i, 2).Value
        Dim settlementTime As String
        settlementTime = ws.Cells(i, 9).Value
        If settlementTime = "2024-5-1" Then
            If Not receivingUserNames.Exists(receivingUserName) Then
                receivingUserNames.Add receivingUserName, 0
            End If
            receivingUserNames(receivingUserName) = receivingUserNames(receivingUserName) + (ws.Cells(i, 3).Value - ws.Cells(i, 4).Value)
        End If
    Next i

    '在新工作表中输出接单用户姓名和接单用户合计
    newWs.Cells(1, 4).Value = "接单用户姓名"
    newWs.Cells(1, 5).Value = "接单用户合计"
    i = 2
    For Each Key In receivingUserNames.Keys
        newWs.Cells(i, 4).Value = Key
        newWs.Cells(i, 5).Value = receivingUserNames(Key)
        i = i + 1
    Next
End Sub

酸茄子

请老师们看下，是哪里错了，运行不起来

酸茄子

#在这里快速回复 各位老师天气热，会在回复最优秀者答谢一杯瑞幸咖啡!！！请大家多多参加回复哦#

混沌音符

一跑起来不就提示Dim settlementTime As String重复声明了吗？

Dim 跟Set CreateObject("Scripting.Dictionary")最好放最前面，一起声明

另外，应该去VBA区提问吧?

酸茄子

混沌音符 发表于 2024-6-25 15:49
一跑起来不就提示Dim settlementTime As String重复声明了吗？

Dim 跟Set CreateObject("Scripting.Dic ...

第一次发错地方了

混沌音符

酸茄子 发表于 2024-6-25 12:55
Sub GenerateNewStatistics()
    Dim ws As Worksheet
    Dim lastRow As Long

这是自己写的吗？一口气写出来的？有运行过吗？