[已解决]代码出错，求助各位高手！

风之子1978

我的程序运行错误，要求是对meigesheet表都进行相同的操作：
1，如果G列的某一行的数值的绝对值大于0.3，那么就需要删除J列这一行的那个数值，，同时还要删除这个值上下的两个值；
2，如果H列的某一行的绝对值大于40，同样，需要删除J列这一行的那个数值，，同时还要删除这个值上下的两个值；
3，如果I列的某一行的绝对值大于10000，同样，需要删除J列这一行的那个数值，，同时还要删除这个值上下的两个值；
heet2，sheet3.。。。。。。都进行相同的操作， 具体见附件，谢谢了！


Sub Macro2()

Dim arr, i&, k&
For k = 1 To Sheets.Count
    If Sheets(k).Range("a1") <> "" Then
        arr = Range("a1").CurrentRegion
        For i = 1 To UBound(arr)
            If Abs(arr(i, 7)) > 0.3 Or Abs(arr(i, 8)) > 40 Or Abs(arr(i, 9)) > 10000 Then arr(i, 10) = ""
            If i > 1 And i < UBound(arr) Then
                If Abs(arr(i, 7)) > 0.3 Or Abs(arr(i, 8)) > 40 Or Abs(arr(i, 9)) > 10000 Then arr(i - 1, 10) = "": arr(i + 1, 10) = ""
            End If
        Next
        Sheets(k).Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    End If
Next
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2013-4-27 10:11

Sub Macro2()

Dim arr, i&, k&
For k = 1 To Sheets.Count
    If Sheets(k).Range("a1") <> "" Then
        arr = Sheets(k).Range("a1").CurrentRegion
        For i = 1 To UBound(arr)
            If Abs(arr(i, 7)) > 0.3 Or Abs(arr(i, 8)) > 40 Or Abs(arr(i, 9)) > 10000 Then arr(i, 10) = ""
            If i > 1 And i < UBound(arr) Then
                If Abs(arr(i, 7)) > 0.3 Or Abs(arr(i, 8)) > 40 Or Abs(arr(i, 9)) > 10000 Then arr(i - 1, 10) = "": arr(i + 1, 10) = ""
            End If
        Next
        Sheets(k).Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    End If
Next
End Sub

跳转到最佳答案楼层

风之子1978

运行代码以后，本来每个sheet的数据是不同的，运行程序之后，每个sheet的数据变成相同的了。

zjdh

Sub Macro2()

Dim arr, i&, k&
For k = 1 To Sheets.Count
    If Sheets(k).Range("a1") <> "" Then
        arr = Sheets(k).Range("a1").CurrentRegion
        For i = 1 To UBound(arr)
            If Abs(arr(i, 7)) > 0.3 Or Abs(arr(i, 8)) > 40 Or Abs(arr(i, 9)) > 10000 Then arr(i, 10) = ""
            If i > 1 And i < UBound(arr) Then
                If Abs(arr(i, 7)) > 0.3 Or Abs(arr(i, 8)) > 40 Or Abs(arr(i, 9)) > 10000 Then arr(i - 1, 10) = "": arr(i + 1, 10) = ""
            End If
        Next
        Sheets(k).Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    End If
Next
End Sub