[已解决]删除有两组连续数字的行

ymq123 · 发表于 2013-11-7 14:12

本帖最后由 ymq123 于 2013-11-7 15:32 编辑

1、请编写代码，删除第一组连续数字是2个数、第二组连续数字是3个数的行。
如第一行中1、2是二个连续数字，7、8、9是三个连续数字，删除此类行。
2、删除合值是24的行。如第八行的合值是24

最佳答案

xdragon

2013-11-7 15:18

Sub deleterow()
Dim arr(), brr(), i As Integer, j As Byte, m As Integer, counter As Byte, counter1 As Byte, counter2 As Byte
arr = Range("A1:I8").Value
Range("A1:I8").Clear
ReDim brr(1 To UBound(arr, 2), 1 To 1)
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Len(arr(i, j)) <> 0 And UBound(arr, 2) <> j Then
counter = counter + 1
Else
If Len(arr(i, j)) <> 0 Then counter = counter + 1
If counter = 2 Then counter1 = counter
If counter = 3 And counter1 = 2 Then counter2 = counter
counter = 0
End If
sums = sums + arr(i, j)
Next
If Not (sums = 24 Or counter1 = 2 And counter2 = 3) Then
m = m + 1
ReDim Preserve brr(1 To UBound(arr, 2), 1 To m)
For j = 1 To UBound(arr, 2)
brr(j, m) = arr(i, j)
Next
End If
counter = 0: counter1 = 0: counter2 = 0: sums = 0
Next
Range("A1").Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
Range("A1").Resize(UBound(brr, 2), UBound(brr)).Borders.LineStyle = xlContinuous
End Sub

复制代码

注译的话，语法可以看帮助，至于思路么，应该能理解的吧。。。

CheryBTL · 发表于 2013-11-7 14:48

ymq123 · 发表于 2013-11-7 15:03

CheryBTL 发表于 2013-11-7 14:48

老师你好，我想请你在代码后面加注释，可以吗？谢谢

那么的帅 · 发表于 2013-11-7 15:07

xdragon · 发表于 2013-11-7 15:18

Sub deleterow()
Dim arr(), brr(), i As Integer, j As Byte, m As Integer, counter As Byte, counter1 As Byte, counter2 As Byte
arr = Range("A1:I8").Value
Range("A1:I8").Clear
ReDim brr(1 To UBound(arr, 2), 1 To 1)
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Len(arr(i, j)) <> 0 And UBound(arr, 2) <> j Then
counter = counter + 1
Else
If Len(arr(i, j)) <> 0 Then counter = counter + 1
If counter = 2 Then counter1 = counter
If counter = 3 And counter1 = 2 Then counter2 = counter
counter = 0
End If
sums = sums + arr(i, j)
Next
If Not (sums = 24 Or counter1 = 2 And counter2 = 3) Then
m = m + 1
ReDim Preserve brr(1 To UBound(arr, 2), 1 To m)
For j = 1 To UBound(arr, 2)
brr(j, m) = arr(i, j)
Next
End If
counter = 0: counter1 = 0: counter2 = 0: sums = 0
Next
Range("A1").Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
Range("A1").Resize(UBound(brr, 2), UBound(brr)).Borders.LineStyle = xlContinuous
End Sub

复制代码

注译的话，语法可以看帮助，至于思路么，应该能理解的吧。。。

CheryBTL · 发表于 2013-11-7 15:33

增加注释后，请查收：

		自动登录	找回密码
密码			注册