关于插入一个空白行的问题，大神帮忙

豆包不是馒头

日期每递增一天，就在上一个日期的最后一天之后自动插入一空白行

ming0018

从下往上插入

豆包不是馒头

大量数据的时候手动插入太慢了，能不能VBA弄一下？

yuygog

1. Sub 插入行()
   
2. On Error Resume Next
   
3. Dim arr
   
4. arr = Range([A1], Cells(Rows.Count, "A").End(xlUp))
   
5. Dim d As Object
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. For i = 2 To UBound(arr)
   
8. d.Add arr(i, 1), ""
   
9. Next i
   
10. Dim wyz
    
11. wyz = d.keys
    
12. Application.ScreenUpdating = False
    
13. For item = 0 To UBound(wyz)
    
14. For Each cell In Range([A1], Cells(Rows.Count, "A").End(xlUp))
    
15. If WorksheetFunction.Clean(cell.Value) = WorksheetFunction.Clean(wyz(item)) Then
    
16. cell.EntireRow.Insert shift:=xlShiftDown
    
17. Exit For
    
18. End If
    
19. Next cell
    
20. Next item
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

豆包不是馒头

yuygog 发表于 2019-3-21 17:26

谢谢大神出手相助~~~~~~~~~~

paralla

豆包不是馒头 发表于 2019-3-23 09:23
谢谢大神出手相助~~~~~~~~~~

他写这个运行起来没问题么？

豆包不是馒头

paralla 发表于 2019-3-23 11:03
他写这个运行起来没问题么？

已经试了，没问题

paralla

豆包不是馒头 发表于 2019-3-23 11:05
已经试了，没问题

我怎么测试完，首行多了一行空白行，另附个人代码

1. Sub InsertRow()
   
2.     Application.ScreenUpdating = False
   
3.     Dim arr, i%
   
4.     arr = [A1].CurrentRegion
   
5.     For i = UBound(arr) To 2 Step -1
   
6.         If arr(i - 1, 1) <> arr(i, 1) Then
   
7.             Cells(i, 1).EntireRow.Insert shift:=xlShiftDown
   
8.         End If
   
9.     Next
   
10.     Application.ScreenUpdating = True
    
11. End Sub

复制代码