求大神帮看下怎么缩写~~

badjinxin

大概的意思就是 如果是2并且下面是合计就加16个空白行。如果是3就加15个空白行 。。。。写出来之后 单个可以运行 全部放在一起 就卡死了。。。。卡死了。。。。
Sub t2()
Dim x As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim i5 As Integer
Dim i6 As Integer
Dim i7 As Integer
Dim i8 As Integer
Dim i9 As Integer
Dim i10 As Integer
Dim i11 As Integer
Dim i12 As Integer
Dim i13 As Integer
Dim i14 As Integer
Dim i15 As Integer
Dim i16 As Integer
Dim i17 As Integer


For x = 1 To 2000
For i1 = 1 To 500 Step 18
For i2 = 2 To 500 Step 18
For i3 = 3 To 500 Step 18
For i4 = 4 To 500 Step 18
For i5 = 5 To 500 Step 18
For i6 = 6 To 500 Step 18
For i7 = 7 To 500 Step 18
For i8 = 8 To 500 Step 18
For i9 = 9 To 500 Step 18
For i10 = 10 To 500 Step 18
For i11 = 11 To 500 Step 18
For i12 = 12 To 500 Step 18
For i13 = 13 To 500 Step 18
For i14 = 14 To 500 Step 18
For i15 = 15 To 500 Step 18
For i16 = 16 To 500 Step 18
For i17 = 17 To 500 Step 18
If Cells(x, 1) = i1 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 17)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i2 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 16)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i3 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 15)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i4 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 14)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i5 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 13)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i6 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 12)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i7 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 11)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i8 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 10)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i9 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 9)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i10 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 8)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i11 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 7)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i12 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 6)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i13 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 5)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i14 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 4)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i15 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 3)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i16 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 2)).Select
Selection.Insert Shift:=xlDown
ElseIf Cells(x, 1) = i17 And Cells(x + 1, 1) = "合计" Then
Rows((x + 1) & ":" & (x + 1)).Select
Selection.Insert Shift:=xlDown


End If
Next i17
Next i16
Next i15
Next i14
Next i13
Next i12
Next i11
Next i10
Next i9
Next i8
Next i7
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
Next x


End Sub

badjinxin

全世界的大神快来看看啊

huang1314wei

请上传附件，这代码写的，不敢恭维

我是来讨说法的

建议上传附件

badjinxin

这个是附件。我的代码，如果分成19次执行 还是可以得。。。。但是19个放在一起 就会卡死

badjinxin

huang1314wei 发表于 2015-11-13 15:08
请上传附件，这代码写的，不敢恭维

已经上传了。我知道写的太繁琐了。但是不知道怎么缩写。

badjinxin

我是来讨说法的 发表于 2015-11-13 15:11
建议上传附件

已经上传了，不过 我的代码应该能看懂吧

huang1314wei

badjinxin 发表于 2015-11-13 15:14
已经上传了。我知道写的太繁琐了。但是不知道怎么缩写。

你光上传一个附件，也没有描述你要达到的具体目的，谁知道你要干吗？为什么不写清楚你要达到的目的？

badjinxin

huang1314wei 发表于 2015-11-13 15:24
你光上传一个附件，也没有描述你要达到的具体目的，谁知道你要干吗？为什么不写清楚你要达到的目的？

就是，如果CELL(X,1)=1或者19，37等等且cells(x+1,1)="合计"那么就插入17个空白行，如果CELL(X,1)=2，20，38并且下面等于合计 就插入16个空白行，是3就插入15个空白行 以此类推

huang1314wei

badjinxin 发表于 2015-11-13 15:29
就是，如果CELL(X,1)=1或者19，37等等且cells(x+1,1)="合计"那么就插入17个空白行，如果CELL(X,1)=2，20 ...

到底是小计还是合计，我看到你的附件当中，合计只有一个，小计倒不少，能不能认真点？