[已解决]请删除表格中有5个奇数的行

ymq123

请删除表格中有5个奇数的行.谢谢！

最佳答案

月排行榜 / 总排行榜

青城山苦丁茶

2013-10-31 21:55

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, m As Integer, temp As Integer
    Dim r As Integer
    Dim ar, re
    ar = Sheets(1).Range(Cells(1, 1), Cells(6, 11))
    ReDim re(1 To UBound(ar), 1 To 11)
    For i = 1 To UBound(ar)
        m = 0
        For j = 1 To 11 Step 2
            m = m + (ar(i, j) Mod 2)
        Next j
        If m < 5 Then
            r = r + 1
            For j = 1 To 11
                re(r, j) = ar(i, j)
            Next j
        End If
    Next i
    Sheets(1).[o1].Resize(UBound(ar), 11) = re
End Sub

跳转到最佳答案楼层

sliang28

附件请参考

CheryBTL

关键是你的r不是每次都符0，只要起始值为0即可。

1. Private Sub CommandButton1_Click()
   
2. Dim i As Integer, j As Integer, m As Integer, temp As Integer
   
3.     Dim r As Integer
   
4.     Dim ar, re
   
5.     ar = Sheets(1).Range(Cells(1, 1), Cells(6, 11))
   
6.     ReDim re(1 To UBound(ar), 1 To 11)
   
7.     For i = 1 To UBound(ar)
   
8.         m = 0: temp = 0
   
9.         For j = 1 To 11
   
10.             If ar(i, j) Mod 2 = 0 Then
    
11.                 If temp < m Then temp = m
    
12.                 m = 0
    
13.             Else
    
14.                 m = m + 1
    
15.             End If
    
16.         Next j
    
17.         If temp < m Then temp = m
    
18.         If temp < 5 Then
    
19.             r = r + 1
    
20.             For j = 1 To 11
    
21.                 re(r, j) = ar(i, j)
    
22.             Next j
    
23.         End If
    
24.     Next i
    
25.     Sheets(1).[o1].Resize(UBound(ar), 11) = re
    
26. End Sub

复制代码

青城山苦丁茶

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, m As Integer, temp As Integer
    Dim r As Integer
    Dim ar, re
    ar = Sheets(1).Range(Cells(1, 1), Cells(6, 11))
    ReDim re(1 To UBound(ar), 1 To 11)
    For i = 1 To UBound(ar)
        m = 0
        For j = 1 To 11 Step 2
            m = m + (ar(i, j) Mod 2)
        Next j
        If m < 5 Then
            r = r + 1
            For j = 1 To 11
                re(r, j) = ar(i, j)
            Next j
        End If
    Next i
    Sheets(1).[o1].Resize(UBound(ar), 11) = re
End Sub

ymq123

青城山苦丁茶 发表于 2013-10-31 21:55
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, m As Integer, temp As Integer
...

如果删除偶怎么改代码？谢谢！

青城山苦丁茶

For i = 1 To UBound(ar)
         m = 0
         For j = 2 To 10 Step 2
             m = m - (ar(i, j) > 0)
         Next j
         If m < 5 Then
             r = r + 1
             For j = 1 To 11
                 re(r, j) = ar(i, j)
             Next j
         End If
     Next i

青城山苦丁茶

也可以
For i = 1 To UBound(ar)
         For m = 2 To 10 Step 2
            If ar(i, m) < 1 Then Exit For
         Next
         If m < 11 Then
             r = r + 1
             For j = 1 To 11
                 re(r, j) = ar(i, j)
             Next j
         End If
     Next i

ymq123

青城山苦丁茶 发表于 2013-10-31 22:42
也可以
For i = 1 To UBound(ar)
         For m = 2 To 10 Step 2

For j = 1 To 11 能不能改为   For j = 1 To UBound(ar,2)  谢谢

青城山苦丁茶

当然可以。step 2要加起，要不多些无用功

ymq123

青城山苦丁茶 发表于 2013-10-31 23:02
当然可以。step 2要加起，要不多些无用功

请“step 2要加起”怎么正解？谢谢！