排序由B改为C如何修改

djyang

排序由B改为C如何修改

ub 按钮7_Click() Dim arr, d, d2, i&, zf$Set d = CreateObject("scripting.dictionary")Set d2 = CreateObject("scripting.dictionary")arr = Range("a1").CurrentRegionFor i = 2 To UBound(arr) Z = arr(i, 1) & "," & arr(i, 3)d2(Z) = d2(Z) + 1 s = (d2(Z) - 1) \ 6 zf = Z & "," & sIf Not d.exists(zf) Thenn = n + 1d(zf) = narr(i, 2) = nElsearr(i, 2) = d(zf)End IfNextRange("b1").Resize(UBound(arr)) = Application.Index(arr, 0, 2)End Sub 统计单.zip (181.55 KB, 下载次数: 9)

2024-9-6 11:04 上传

点击文件名下载附件

djyang

出错了请老师修改
Sub px()
    Dim arr, d, d2, i&, zf$, n As Long
    Set d = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    arr = Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        ' 修改这里，从B列改为C列
        Z = arr(i, 1) & "," & arr(i, 4) ' 第4列是C列
        d2(Z) = d2(Z) + 1
        s = (d2(Z) - 1) \ 6
        zf = Z & "," & s
        If Not d.exists(zf) Then
            n = n + 1
            d(zf) = n
            arr(i, 2) = n ' 这里假设你仍然想在B列存储排序的结果（或任何其他逻辑）
        Else
            arr(i, 2) = d(zf)
        End If
    Next i
    ' 如果你希望将排序结果写回到C列，请改为Range("C1").Resize(UBound(arr, 1) - 1)
    ' 注意这里我使用了UBound(arr, 1) - 1因为CurrentRegion可能包括标题行
    Range("C1").Resize(UBound(arr, 1) - 1).Value = Application.Index(arr, 1 To UBound(arr, 1), 2)
End Sub

djyang

老师们错在哪里

yes_cn

不知道理解是否正确，参与一下。

1. Sub px()
   
2.     Dim arr, d, d2, i&, zf$, n As Long
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d2 = CreateObject("scripting.dictionary")
   
5.     arr = Range("A1").CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         Z = arr(i, 1) & "," & arr(i, 4) ' 第4列是C列
   
8.         d2(Z) = d2(Z) + 1
   
9.         s = (d2(Z) - 1) \ 6
   
10.         zf = Z & "," & s
    
11.         If Not d.exists(zf) Then
    
12.             n = n + 1
    
13.             d(zf) = n
    
14.             arr(i, 3) = n ' 将结果存储在C列（第3列）
    
15.         Else
    
16.             arr(i, 3) = d(zf)
    
17.         End If
    
18.     Next i
    
19.     Range("C1").Resize(UBound(arr, 1) - 1).Value = Application.Index(arr, 0, 3)
    
20. End Sub

复制代码

djyang

yes_cn 发表于 2024-9-6 18:44
不知道理解是否正确，参与一下。

谢谢老师，已解决