请教在数组中如何写条件判断再循环

417744370

想得到的结果图
原数据图


Sub 测试()
Dim Arr, Brr(), i%, n%, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Sheets("Sheet1").Cells.Clear
Arr = Sheets("原表").UsedRange
ReDim Brr(1 To UBound(Arr), 1 To 16)
For i = 1 To UBound(Arr)
Dic(Arr(i, 3)) = Dic(Arr(i, 3)) + 1
      If Dic(Arr(i, 3)) > 1 Then ‘此条件只显示大于1的数据。若输入Dic(Arr(i, 3)) =Arr(i, 3)无效
      
        n = n + 1
        Brr(n, 1) = Arr(i, 1)
        Brr(n, 2) = Arr(i, 2)
        Brr(n, 3) = Arr(i, 3)
        Brr(n, 4) = Arr(i, 4)
        Brr(n, 5) = Arr(i, 5)
        Brr(n, 6) = Arr(i, 6)
        Brr(n, 7) = Arr(i, 7)
        Brr(n, 8) = Arr(i, 8)
        Brr(n, 9) = Arr(i, 9)
        Brr(n, 10) = Arr(i, 10)
        Brr(n, 11) = Arr(i, 11)
        Brr(n, 12) = Arr(i, 12)
        Brr(n, 13) = Arr(i, 13)
        Brr(n, 14) = Arr(i, 14)
        Brr(n, 15) = Arr(i, 15)
        Brr(n, 16) = Arr(i, 16)
    End If
Next i
Sheets("Sheet1").[a2].CurrentRegion.ClearContents
Sheets("Sheet1").Range("A1").Resize(1, 16) = Array("客户编号", "企业名称", "真实姓名", "手机号", "注册身份证", 0, "受理地市", "委托起始日", "委托到期日", "客户经理", "客户经理手机", "提交日期", "提交时间", "授权证明", "身份证", "企业编号")
Sheets("Sheet1").[a2].Resize(n, 16) = Brr
End Sub

417744370

麻烦大老们给指点，谢谢！！

fzxba

1. Sub test0()
   
2.   Dim ar, Dict As Object, i As Long
   
3.   Set Dict = CreateObject("Scripting.Dictionary")
   
4.   Sheet1.Activate
   
5.   ar = Range("C2", Cells(Rows.Count, "C").End(xlUp)).Value
   
6.   For i = 1 To UBound(ar)
   
7.     Dict(ar(i, 1)) = Dict(ar(i, 1)) + 1
   
8.     ar(i, 1) = Dict(ar(i, 1))
   
9.   Next
   
10.   Range("G2").Resize(UBound(ar)) = ar
    
11.   Set Dict = Nothing
    
12. End Sub

复制代码

cjc209

是不是用数组循环计算g列的值? 就是循环加字典计数就可以了

gwjkkkkk

cjc209 发表于 2024-2-7 17:18
是不是用数组循环计算g列的值? 就是循环加字典计数就可以了

字典计数应该最简单了

今铭昔

cjc209

今铭昔 发表于 2024-2-7 17:56

(this[n]??=1,this) 这是什么语法 在哪里学的?

417744370

谢谢各位大老，非常感谢

今铭昔

cjc209 发表于 2024-2-7 21:33
(this[n]??=1,this) 这是什么语法 在哪里学的?

这个this是map的第二参，是个字典对象，this是进阶JS面向对象编程的一道坎，这个一时说不清楚，百度看文档吧，JS不缺资料。

417744370

Sub 测试() Dim Arr, Brr(), i%, n%, Dic As Object Set Dic = CreateObject("scripting.dictionary") Sheets("Sheet1").Cells.Clear Arr = Sheets("原表").UsedRange ReDim Brr(1 To UBound(Arr), 1 To 16) For i = 1 To UBound(Arr)  Dic(Arr(i, 3)) = Dic(Arr(i, 3)) + 1       If Dic(Arr(i, 3)) > 1 Then  '输入这个条件少1条记录，只有大于1的。如何才能等于range("c1")=range("c2")这样的条件？？                n = n + 1         Brr(n, 1) = Arr(i, 1)         Brr(n, 2) = Arr(i, 2)         Brr(n, 3) = Arr(i, 3)         Brr(n, 4) = Arr(i, 4)         Brr(n, 5) = Arr(i, 5)         Brr(n, 6) = Arr(i, 6)         Brr(n, 7) = Arr(i, 7)         Brr(n, 8) = Arr(i, 8)         Brr(n, 9) = Arr(i, 9)         Brr(n, 10) = Arr(i, 10)         Brr(n, 11) = Arr(i, 11)         Brr(n, 12) = Arr(i, 12)         Brr(n, 13) = Arr(i, 13)         Brr(n, 14) = Arr(i, 14)         Brr(n, 15) = Arr(i, 15)         Brr(n, 16) = Arr(i, 16)     End If Next i Sheets("Sheet1").[a2].CurrentRegion.ClearContents Sheets("Sheet1").Range("A1").Resize(1, 16) = Array("客户编号", "企业名称", "真实姓名", "手机号", "注册身份证", 0, "受理地市", "委托起始日", "委托到期日", "客户经理", "客户经理手机", "提交日期", "提交时间", "授权证明", "身份证", "企业编号") Sheets("Sheet1").[a2].Resize(n, 16) = Brr End Sub