Question

我一直在努力奋斗几个小时，并认为可能是时候寻求帮助了。

我有数百个电子表格，我想手动打开，然后使用宏进行简化。每个电子表格都有一个医院列表（大约400个），我想限制每个只显示100家医院的数据。医院通过列中的三个字母的缩写来标识，其位置（行/列）不同但总是标题为“＃34; Code＆＃34;。

因此，例如，我希望宏删除所有不包含值的行＆＃34; Code＆＃34;，＆＃34; ABC＆＃34;，＆＃34; DEF＆＃34;，＆＃34; GEH＆＃34;等

我不是普通的Excel用户，只需要用它来解决这个问题......！

我已尝试附加代码，但它有几个错误：

删除包含＆＃34; ABC＆＃34;的行。同样。如果我定义范围（＆＃34; B1：B100＆＃34;），则该问题消失，但如果范围扩展到多个列（例如＆＃34; A1：E100＆＃34;）则不会消失。令人沮丧的是＆＃34; Code＆＃34;列在电子表格中各不相同。
由于我想保存100个医院代码，感觉好像应该有比使用＆＃34; Or＆＃34;更好的方法。运营商100次。

有人可以帮忙吗？

Sub Clean()
Dim c As Range
Dim MyRange As Range
LastRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row
Set MyRange = Range("A1:E100")
For Each c In MyRange
  If c.Value = "Code" Then
    c.EntireRow.Interior.Color = xlNone
  ElseIf c.Value = "ABC" Or c.Value = "DEF" Then
    c.EntireRow.Interior.Color = vbYellow
  Else
    c.EntireRow.Delete
  End If
Next
End Sub

Answer 1

试试这个：

Option Explicit

Sub Clean()

    Dim rngRow      As Range
    Dim rngCell     As Range
    Dim MyRange     As Range
    Dim blnDel      As Boolean
    Dim lngCount    As Long

    Set MyRange = Range("A1:E8")

    For lngCount = MyRange.Rows.Count To 1 Step -1

        blnDel = False
        For Each rngCell In MyRange.Rows(lngCount).Cells

            If rngCell = "ABC" Then

                rngCell.EntireRow.Interior.Color = vbRed
                blnDel = True

            ElseIf rngCell = "DEF" Then
                rngCell.EntireRow.Interior.Color = vbYellow
                blnDel = True
            End If
        Next rngCell

        If Not blnDel Then Rows(lngCount).Delete
    Next lngCount

End Sub

通常，您需要循环遍历行，然后遍历每行中的每个单元格。为了让程序记住是否应该在给定行上删除某些内容，在两个循环之间有一个blnDel，如果没有DEF或ABC则删除该行被发现了。

VBA中行删除中存在问题的部分是，您应该小心删除始终正确的部分。因此，您应该从最后一行开始进行反向循环。

Answer 2

Option Explicit
Sub Clean()
    Dim c As Range, MyRange As Range, DelRng As Range, Code As Range, CodeList As Range
    Dim CodeCol As Long, LastRow As Long

    ''Uncomment the below. I'd put all of your codes into one sheet and then test if the value is in that range
    'With CodeListSheet
    '    Set CodeList = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    'End With

    ' Update this to point at the relevant sheet
    ' If you're looking at multiple sheets you can loop through the sheets starting your loop here
    With Sheet1
        Set Code = .Cells.Find("Code")
        If Not Code Is Nothing Then
            CodeCol = Code.Column
            LastRow = .Cells(Cells.Rows.Count, CodeCol).End(xlUp).Row
            Set MyRange = .Range(.Cells(1, CodeCol), .Cells(LastRow, CodeCol))

            For Each c In MyRange
                If c.Value2 = "Code" Then
                    c.EntireRow.Interior.Color = xlNone
                '' Also uncomment this one to replace your current one
                'ElseIf WorksheetFunction.CountIf(CodeList, c.Value2) > 0 Then
                ElseIf UCase(c.Value2) = "ABC" Or c.Value2 = "DEF" Then
                    c.EntireRow.Interior.Color = vbYellow
                Else
                    If DelRng Is Nothing Then
                        Set DelRng = c
                    Else
                        Set DelRng = Union(DelRng, c)
                    End If
                End If
            Next c

            If Not DelRng Is Nothing Then DelRng.EntireRow.Delete
        Else
            MsgBox "Couldn't find correct column"
            Exit Sub
        End If
    End With
End Sub

如何删除不包含特定值的所有行？

2 个答案: