表1去空然后复制到表2之VBA

jylai

请老师帮忙

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.3.3
   
2.     r = Me.Cells(Rows.Count, 1).End(3).Row
   
3.     arr = Me.[a1].Resize(r, 6)
   
4.     ReDim brr(1 To UBound(arr), 1 To 6)
   
5.     For i = 2 To UBound(arr)
   
6.         Sum = 0
   
7.         For j = 1 To UBound(arr, 2)
   
8.             Sum = Sum + Val(arr(i, j))
   
9.         Next
   
10.         If Sum <> 0 Then
    
11.             m = m + 1
    
12.             For j = 1 To UBound(arr, 2)
    
13.                 brr(m, j) = arr(i, j)
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     Me.[j2:o1000] = ""
    
18.     Me.[j2].Resize(m, 6) = brr
    
19.     Me.[j2].Resize(m, 6).Borders.LineStyle = 1
    
20.     ActiveWindow.DisplayZeros = False
    
21. End Sub
    

复制代码

jylai

老师您太厉害了，感谢您！