关于按照条件插入行的问题

小女孩

这是一个账目，有的某日数量没动，表里就没统计，现在想填上，哪位老师帮我看一下，十分感谢！ 求助.rar (35.21 KB, 下载次数: 10)

2025-1-27 20:09 上传

点击文件名下载附件

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2025.1.27
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 8)
   
6.         rq1 = CDate(arr(2, 1))
   
7.         rq2 = CDate(arr(r, 1))
   
8.     End With
   
9.     ReDim brr(1 To 10 ^ 4, 1 To UBound(arr, 2))
   
10.     For i = 2 To UBound(arr)
    
11.         s = CDate(arr(i, 1))
    
12.         d(s) = i
    
13.     Next
    
14.     For k = rq1 To rq2
    
15.         m = m + 1
    
16.         If d.exists(k) Then
    
17.             For j = 1 To UBound(arr, 2)
    
18.                 brr(m, j) = arr(d(k), j)
    
19.             Next
    
20.         Else
    
21.             For j = 1 To UBound(arr, 2)
    
22.                 brr(m, j) = brr(m - 1, j)
    
23.             Next
    
24.             brr(m, 1) = k: brr(m, 5) = 0
    
25.         End If
    
26.     Next
    
27.     With Sheets("Sheet2")
    
28.         Intersect(.UsedRange, .[A:h]).Offset(1) = Empty
    
29.         .[a2].Resize(m, 8) = brr
    
30.     End With
    
31.     Set d = Nothing
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码

小女孩

ykcbf1100 发表于 2025-1-27 20:35
参与一下。。。

谢谢老师！新春快乐！

小女孩

这个有点问题，BCD列内容不要有，我用黄色背景那个内容不应该有，老师能看一下么 求助2.rar (44.49 KB, 下载次数: 5)

2025-1-27 21:58 上传

点击文件名下载附件

taller

小女孩

taller 发表于 2025-1-30 03:19

十分感谢！祝您春节快乐！