填充日期和删除相关的行

ykcbf1100

vicky427000 发表于 2024-5-17 22:02
是在原表删除

附件供参考，表不限，原表上删除。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.18
   
2.     Application.ScreenUpdating = False
   
3.     Set sh = ThisWorkbook.Sheets("操作台")
   
4.     For Each sht In Sheets
   
5.         If sht.Name <> sh.Name Then
   
6.             m = 0
   
7.             ReDim brr(1 To 10000, 1 To 3)
   
8.             With sht
   
9.                 r = .Cells(Rows.Count, 2).End(3).Row
   
10.                 .Columns(4).ClearContents
    
11.                 arr = .[a1].Resize(r, 3)
    
12.                 For i = 2 To UBound(arr)
    
13.                     If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
    
14.                     If arr(i, 3) <> Empty Then
    
15.                         m = m + 1
    
16.                         For j = 1 To UBound(arr, 2)
    
17.                             brr(m, j) = arr(i, j)
    
18.                         Next
    
19.                     End If
    
20.                 Next
    
21.                 .UsedRange.Offset(1).ClearContents
    
22.                 .[a2].Resize(m, 3) = brr
    
23.             End With
    
24.         End If
    
25.     Next
    
26.     sh.Activate
    
27.     Application.ScreenUpdating = False
    
28.     MsgBox "OK！"
    
29. End Sub
    
30. 
    

复制代码