两列数据比较问题

wzwujiebg

麻烦大神帮帮忙。I=D-H，如果I>0则A:D插入行;I<0则F:H插入行;I=0,则比较下一行。

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    r = Cells(Rows.Count, 9).End(3).Row
    arr = [a1].Resize(r, 9)
    For j = UBound(arr) To 2 Step -1
        If arr(j, 9) > 0 Then
            Cells(j, 1).Resize(1, 4).Insert
        Else
            If arr(j, 9) < 0 Then
                Cells(j, 6).Resize(1, 3).Insert
            End If
        End If
    Next j
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容，楼主看下理解的对不对吧

wzwujiebg

很抱歉，可能是我的表达不够清晰。我想要的结果如附图

格物郅知

1、先不说你你描述，你不觉得你这几个数据有七百多k很不正常吗？不觉得打开特别卡吗？按下筛选，都到XFZ列（16372列）了。给你精简了。
2、不要惜字如金，说的不明不白，只能猜。不知道你移动下来的那部分要怎么搞，看下附件效果吧，提供两种方案。

1. Sub 插入1()
   
2. '这是根据版主大大的改的，正向循环了
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlManual
   
5.     r = Cells(Rows.Count, 4).End(3).Row
   
6.     arr = [a1].Resize(r, 9)
   
7.     For j = 2 To r 'UBound(arr) ' To 2 Step -1
   
8.         If Sheet1.Cells(j, 4) - Sheet1.Cells(j, 8) > 0 Then
   
9.             Cells(j, 1).Resize(1, 4).Insert
   
10.         Else
    
11.             If Sheet1.Cells(j, 4) - Sheet1.Cells(j, 8) < 0 Then
    
12.                 Cells(j, 6).Resize(1, 3).Insert
    
13.             End If
    
14.         End If
    
15.     Next j
    
16. 
    
17. r = Cells(Rows.Count, 6).End(3).Row
    
18. For j = 2 To r
    
19. Sheet1.Cells(j, 9) = Sheet1.Cells(j, 4) - Sheet1.Cells(j, 8)
    
20. Next
    
21. 
    
22.     Application.Calculation = xlAutomatic
    
23.     Application.ScreenUpdating = True
    
24. End Sub
    
25. 
    
26. 
    
27. Sub 插入2()
    
28. '本来也想循环的，但是实在不知道怎么重新给循环截止次数重新赋值，有会的老师指导一下吗？
    
29. Application.ScreenUpdating = False
    
30. Application.Calculation = xlManual
    
31.     r = Cells(Rows.Count, 4).End(3).Row
    
32.     arr = [a1].Resize(r, 9)
    
33.     a = 2
    
34.     f = 2
    
35. x:
    
36.     If Sheet1.Cells(a, 4) - Sheet1.Cells(a, 8) > 0 Then
    
37.         Cells(a, 1).Resize(1, 4).Insert
    
38.         a = a + 1
    
39.         x = x + 1
    
40.     Else
    
41.         If Sheet1.Cells(a, 4) - Sheet1.Cells(a, 8) < 0 Then
    
42.             Cells(a, 6).Resize(1, 3).Insert
    
43.             f = f + 1
    
44.         End If
    
45.     End If
    
46.     a = a + 1
    
47.     f = f + 1
    
48. If a > r + x Then
    
49.     GoTo y
    
50.     Else
    
51.     GoTo x
    
52. End If
    
53. 
    
54. y:
    
55. r = Cells(Rows.Count, 6).End(3).Row
    
56. For j = 2 To r
    
57. Sheet1.Cells(j, 9) = Sheet1.Cells(j, 4) - Sheet1.Cells(j, 8)
    
58. Next
    
59. 
    
60. Application.Calculation = xlAutomatic
    
61. Application.ScreenUpdating = True
    
62. End Sub

复制代码

wzwujiebg

格物郅知 发表于 2020-1-8 00:14
1、先不说你你描述，你不觉得你这几个数据有七百多k很不正常吗？不觉得打开特别卡吗？按下筛选，都到XFZ列 ...

第二种方案就是理想的结果，非常感谢。