Question

我需要你的代码帮助，我认为这很复杂。

所以想法是：

<块引用>

对于工作表 1，如果 A 列中的单元格 <> ws.name then

如果 F 列中的单元格 = 55 并且 G 列中的单元格 = 从 1 到 12 然后什么都不做

如果 F 列中的单元格 = 1 到 12 之间的任何数字和 G 列中的单元格 =55 然后什么都不做

else 删除所有其他行

PS：我有大约 20000 行

也适用于工作表 2，如果 A 列中的单元格 <> ws.name then

如果 F 列中的单元格 =51 或 = 53 且 G 列中的单元格 = 55，则执行什么都没有

如果 F 列中的单元格 = 55 且 G 列中的单元格 =51 或 =53，则执行什么都没有

else 删除所有其他行

依此类推，对于每张纸，我将在 F 和 G 列中设置不同的数字条件。

我真的希望你能帮上忙，我已经为此苦苦挣扎了一段时间

这是我在一张纸中尝试的示例代码

Sub loopanddelete()

Dim i As Long, fVal, gVal
Dim ws As Worksheet, rngDel As Range

Application.EnableEvents = False

Set ws = Sheets("209990")

For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If ws.Cells(i, 1) <> ws.Name Then
        fVal = ws.Cells(i, "F").Value
        gVal = ws.Cells(i, "G").Value
        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And (gVal >= 1 And gVal <= 12)) And _
               Not (gVal = 55 And (fVal >= 1 And fVal <= 12)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
        End If
   End If

   If ws.Cells(i, 1) = ws.Name Then
       fVal = ws.Cells(i, "F").Value
       gVal = ws.Cells(i, "G").Value

       If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And ((gVal >= 1 And gVal <= 12) Or gVal = 55)) And _
               Not (gVal = 55 And ((fVal >= 1 And fVal <= 12) Or fVal = 55)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
       End If
  End If
   
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows

  Set ws = Sheets("209991")

  For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If ws.Cells(i, 1) <> ws.Name Then
        fVal = ws.Cells(i, "F").Value
        gVal = ws.Cells(i, "G").Value
        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And (gVal= 51 Or gVal=53)) And _
               Not (gVal = 55 And (fVal =51 Or fVal =53)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
        End If
   End If

 If ws.Cells(i, 1) = ws.Name Then
       fVal = ws.Cells(i, "F").Value
       gVal = ws.Cells(i, "G").Value

        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And ((gVal= 51 Or gVal=53)or gVal=55)) And _
               Not (gVal = 55 And (fVal =51 Or fVal =53)or fVal=55) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
       End If
  End If
   
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows

Set ws = Sheets("209992")

For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If ws.Cells(i, 1) <> ws.Name Then
        fVal = ws.Cells(i, "F").Value
        gVal = ws.Cells(i, "G").Value
        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And (gVal= 50 Or gVal=52)) And _
               Not (gVal = 55 And (fVal =50 Or fVal =52)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
        End If
   End If

If ws.Cells(i, 1) = ws.Name Then
       fVal = ws.Cells(i, "F").Value
       gVal = ws.Cells(i, "G").Value

        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And ((gVal= 50 Or gVal=52)or gVal=55)) And _
               Not (gVal = 55 And (fVal =50 Or fVal =52)or fVal=55) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
       End If
  End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows


Set ws = Sheets("209995")

For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If ws.Cells(i, 1) <> ws.Name Then
        fVal = ws.Cells(i, "F").Value
        gVal = ws.Cells(i, "G").Value
        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And gVal= 45) And _
               Not (gVal = 55 And (fVal =45)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
        End If
   End If

 If ws.Cells(i, 1) = ws.Name Then
       fVal = ws.Cells(i, "F").Value
       gVal = ws.Cells(i, "G").Value

        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And (gVal= 45 or gVal=55)) And _
               Not (gVal = 55 And (fVal =45 or fVal=55)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
       End If
  End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows

Set ws = Sheets("209997")

For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If ws.Cells(i, 1) <> ws.Name Then
        fVal = ws.Cells(i, "F").Value
        gVal = ws.Cells(i, "G").Value
        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And gVal= 57) And _
               Not (gVal = 55 And (fVal =57)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
        End If
   End If

If ws.Cells(i, 1) = ws.Name Then
       fVal = ws.Cells(i, "F").Value
       gVal = ws.Cells(i, "G").Value

        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And (gVal= 47 or gVal=55)) And _
               Not (gVal = 55 And (fVal =47 or fVal=55)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
       End If
  End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows

Set ws = Sheets("209998")

For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If ws.Cells(i, 1) <> ws.Name Then
        fVal = ws.Cells(i, "F").Value
        gVal = ws.Cells(i, "G").Value
        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And gVal= 48) And _
               Not (gVal = 55 And (fVal =48)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
        End If
   End If

If ws.Cells(i, 1) = ws.Name Then
       fVal = ws.Cells(i, "F").Value
       gVal = ws.Cells(i, "G").Value

        If IsNumeric(fVal) And IsNumeric(gVal) Then
            If Not (fVal = 55 And (gVal= 48 or gVal=55)) And _
               Not (gVal = 55 And (fVal =48 or fVal=55)) Then
                BuildRange rngDel, ws.Cells(i, 1)
            End If
       End If
  End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows
End Sub

Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
If rngTot Is Nothing Then
    Set rngTot = rngAdd
Else
    Set rngTot = Application.Union(rngTot, rngAdd)
End If
End Sub

Answer 1

试试这个：

Sub ProcessSheets()

    RemoveRowsByValue Sheets("209990"), 55, 12
    RemoveRowsByValue Sheets("209991"), 44, 9
    RemoveRowsByValue Sheets("209992"), 33, 15

End Sub


Sub RemoveRowsByValue(ws As Worksheet, valOne, valTwo)

    Dim i As Long, fVal, gVal, s
    Dim rngDel As Range 'this range holds the rows to be deleted
    
    Application.EnableEvents = False 'not sure if you really need this...
    
    For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1 'loop backwards
        If ws.Cells(i, 1) <> ws.Name Then   'Col A check
            fVal = ws.Cells(i, "F").Value   'Col F value
            gVal = ws.Cells(i, "G").Value   'Col G value
            If IsNumeric(fVal) And IsNumeric(gVal) Then
                If Not (fVal = valOne And (gVal >= 1 And gVal <= valTwo)) And _
                   Not (gVal = valOne And (fVal >= 1 And fVal <= valTwo)) Then
                    BuildRange rngDel, ws.Cells(i, 1)
                End If
            End If
       End If
    Next i
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows
End Sub

'utility sub to build a range piece-by-piece
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then   'check if we've already begun this range
        Set rngTot = rngAdd     '...if not just make the direct assignment
    Else
        'rngTot already has content, so add `rngAdd` using Union
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub

vba在多个条件下删除每张纸的行

1 个答案: