Excel中VBA对同一ID号对应的数量只保留一个正数

yjwdjfqb

VBA
同一ID号
对应的数量
只保留一个正数
其余的行删除
请老师们帮帮忙，谢谢老师们了！！！


Excel中VBA对同一ID号对应的数量只保留一个正数2.rar (17.81 KB, 下载次数: 9)

2024-3-15 11:13 上传

点击文件名下载附件

ykcbf1100

附件下载后无法打开，请重新上传附件。

yjwdjfqb

ykcbf1100 发表于 2024-3-15 10:54
附件下载后无法打开，请重新上传附件。

Excel中VBA对同一ID号对应的数量只保留一个正数2.rar (17.81 KB, 下载次数: 3)

2024-3-15 11:13 上传

点击文件名下载附件

谢谢老师，上传了，谢谢！！！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.15
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 5).End(3).Row
   
4.     arr = [e1].Resize(r, 5)
   
5.     ReDim brr(1 To UBound(arr), 1 To 5)
   
6.     For i = 5 To UBound(arr)
   
7.         s = CStr(arr(i, 4))
   
8.         If arr(i, 5) > 0 Then
   
9.             If Not d.exists(s) Then
   
10.                 d(s) = Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))
    
11.             End If
    
12.         End If
    
13.     Next
    
14.     Columns(15).NumberFormatLocal = "@"
    
15.     [l5:p10000] = ""
    
16.     [l5].Resize(d.Count, 5) = Application.Rept(d.Items, 1)
    
17.     MsgBox "OK！"
    
18. End Sub
    
19. 
    

复制代码

taller

swl4561255

1. Private Sub CommandButton1_Click()
   
2. arr = Range("E4").CurrentRegion
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For i = 2 To UBound(arr)
   
5.    d(arr(i, 4)) = Range(Cells(i + 3, 5), Cells(i + 3, 9))
   
6. Next
   
7. t = d.items
   
8. [K4].Resize(1, 5) = Array("编号", "年龄", "性别", "ID", "数量")
   
9. [K5].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(t))
   
10. Range("K:O").HorizontalAlignment = xlCenter
    
11. Set d = Nothing
    
12. For j = 1 To Range("K5").CurrentRegion.Rows.Count
    
13.   Cells(j + 4, "K") = j
    
14.   Cells(j + 4, "N").NumberFormat = "00000000000"
    
15. Next
    
16. End Sub
    

复制代码

yjwdjfqb

taller 发表于 2024-3-15 12:00

老师你好，我用到这个附件上面
怎么的结果，没有表头喃
麻烦老师帮修改下，谢谢了老师！
Excel中VBA对同一ID号对应的数量只保留一个正数3.rar (13.68 KB, 下载次数: 5)

2024-3-15 23:15 上传

点击文件名下载附件

taller

yjwdjfqb

taller 发表于 2024-3-16 01:23

非常感谢老师的帮助
很好用
For i = LBound(arrData) + 4 To UBound(arrData)
上句中的+4是从哪儿得来的喃
谢谢老师了！