请教如何按指定条件插入空行

秋枫

letterboxa 发表于 2018-5-22 10:41
谢谢您的帮助！
我又运行了一次，这次可以使用了，只是碰到一个问题，在运行前必须把其他的工作表都关掉 ...

只要这个表在最上面就可以。这个表是当前活动的表。

程序是找到excel, 再找到当前活动表，对它进行处理。

letterboxa

这个是昵称吗 发表于 2018-5-22 10:31
笨方法就是这样吧！！！！！

多谢指教！

gdszczh

代码如下，点击附件--测试表格--中的“插入空行"按钮即可运行。
Sub 插入空行()
Dim k, i, j%
k = Application.CountA(Range("a:a")) * 2
For i = 2 To k
    For j = 1 To 6
        If Cells(i, j).Value <> Cells(i + 1, j) Then
        Cells(i + 1, j).EntireRow.Insert
        i = i + 1
        Exit For
        End If
    Next
Next
End Sub

Chip_Kenny

若數據量很大, 可以用這方法:

1. Sub zz()
   
2. Dim ar, s$, b
   
3. Application.ScreenUpdating = 0
   
4. Columns(1).Insert
   
5. ar = [a1:b1].CurrentRegion.Value
   
6. ar(1, 1) = 1
   
7. For j = 1 To 7
   
8.     ar(2, 1) = ar(2, 1) & "|" & ar(2, j)
   
9. Next
   
10. For i = 3 To UBound(ar)
    
11.     For j = 1 To 7
    
12.         ar(i, 1) = ar(i, 1) & "|" & ar(i, j)
    
13.     Next
    
14.     If ar(i - 1, 1) <> ar(i, 1) Then s = s & "|" & i - 1
    
15.     ar(i - 1, 1) = i - 1
    
16. Next
    
17. ar(i - 1, 1) = i - 1
    
18. b = Split(Mid(s, 2), "|")
    
19. [a1].Resize(i - 1) = ar
    
20. [a1048576].End(3)(2).Resize(UBound(b)) = Application.Transpose(b)
    
21. [a1].CurrentRegion.Sort key1:=[a1], order1:=1, Header:=1
    
22. Columns(1).Delete
    
23. Application.ScreenUpdating = 1
    
24. End Sub

复制代码

jjmysjg

Chip_Kenny 发表于 2018-5-22 15:36
若數據量很大, 可以用這方法:

这个速度快

ggmmlol

如果数据量真的很大，这个还能快一点点：

1. Sub test()
   
2. Dim arr, r&, br(), cr(), i&, j&, n&, c&, p&
   
3. tt = Timer
   
4. arr = Range("a1").CurrentRegion.Resize(, 6)
   
5. r = UBound(arr)
   
6. ReDim br(1 To r, 1 To 1), cr(1 To r, 1 To 1)
   
7. br(1, 1) = 0: p = 1: n = br(p, 1)
   
8. For i = 2 To r
   
9.     For j = 6 To 1 Step -1
   
10.         If arr(i, j) <> arr(p, j) Then Exit For
    
11.     Next
    
12.     If j > 0 Then
    
13.         n = n + 1
    
14.         cr(n, 1) = n
    
15.         p = i
    
16.     End If
    
17.     br(i, 1) = n
    
18. Next
    
19. c = Sheet1.Rows.Find("*", , xlValues, , 2, 2).Column + 1
    
20. Application.ScreenUpdating = False
    
21. Cells(1, c).Resize(r) = br
    
22. Cells(r + 1, c).Resize(n) = cr
    
23. With Range("a1").Resize(r + n, c)
    
24.     .Sort .Cells(1, c), xlAscending, Header:=xlYes
    
25. End With
    
26. Columns(c).Clear
    
27. Application.ScreenUpdating = True
    
28. MsgBox Format(Timer - tt, "用时0.00秒")
    
29. End Sub

复制代码

一壶鱼

请教一下我的这个自动空行怎么用vba啊？？大佬们