Question

前段时间我想创建一个代码，用于清除工作表特定范围内行的内容，但只有在我的范围的第一列中的ID与第一个字符的定义名称匹配的情况下才会这样。我得到了QHarr的大力支持，他使代码工作。

但是，现在，我想扩展代码以获得更多条件，即具有3个ID（定义的名称），行应该匹配然后清除。当前代码适用于1个ID（定义名称），经过多次试验后，我无法通过将条件扩展到3个ID（定义名称）来使其工作

以下是运行代码之前的案例：

这是期望的结果=＆gt;数组中3个ID与定义的名称匹配的行 - 在范围内清除：

以下是适用于1 ID的代码：

func tableView(_ tableView: UITableView, heightForRowAt indexPath: IndexPath) -> CGFloat {
   return 200
}

我试图以多种方式将其扩展到3个ID（定义的名称），但它们都不起作用，例如在陈述中如果左边$（rng.Value，Len（id））= id那么＆＃39; ，我正在添加And，或者对于id2和id3（在以与ID相同的方式声明它们之后） - 但是，代码不会读取它们。我还尝试为id2和id3添加id下面条件的段落 - 但在结果中，表格的全部内容被清除。有人知道扩展它的技巧吗？

Answer 1

以下解决方案的优势在于您可以继续使用开始和结束列的方法来扩展更多范围。

如果您知道它们的长度匹配，您可以这样做：

Option Explicit
Public Sub ClearCells()

    Const COLUMN_START1 As Long = 2
    Const COLUMN_END1 As Long = 5
    Const COLUMN_START2 As Long = 7
    Const COLUMN_END2 As Long = 10
    Const COLUMN_START3 As Long = 12
    Const COLUMN_END3 As Long = 15
    Const START_ROW As Long = 8
    'Const L_MY_DEFINED_NAME As String = "ID"

    Dim loopRanges()

    loopRanges = Array(COLUMN_START1, COLUMN_END1, COLUMN_START2, COLUMN_END2, COLUMN_START3, COLUMN_END3)

    Dim targetSheet As Worksheet, index As Long, unionRng As Range
    Dim id As Long                               'Or , ID As String?

    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    'id = ThisWorkbook.Names(L_MY_DEFINED_NAME).RefersToRange.Value

    Application.ScreenUpdating = False

    With targetSheet

        For index = LBound(loopRanges) To UBound(loopRanges) Step 2

            Dim lngLastRow As Long, ClearRange As Range, rng As Range

            lngLastRow = .Cells(.Rows.Count, loopRanges(index)).End(xlUp).Row '
            If lngLastRow < START_ROW Then lngLastRow = START_ROW

            Set ClearRange = .Range(.Cells(START_ROW, loopRanges(index)), .Cells(lngLastRow, loopRanges(index + 1)))

            For Each rng In ClearRange.Columns(1).Cells
                If Not IsEmpty(rng) Then
                    If Not IsError(Application.Match(rng.Value, targetSheet.Range("B3:B5"), 0)) Then 'Left$(rng.Value, Len(id)) = id Then '<== match found
                        If Not unionRng Is Nothing Then
                            Set unionRng = Union(unionRng, rng.Resize(1, ClearRange.Columns.Count)) '<== gather all matches into a union range

                        Else
                            Set unionRng = rng.Resize(1, ClearRange.Columns.Count)
                        End If
                    End If
                End If
            Next rng
        Next index
    End With

    If Not unionRng Is Nothing Then unionRng.ClearContents '<== or after Then: 'Debug.Print unionRng.Address' to check what is cleared
    Application.ScreenUpdating = True
MsgBox "Done", vbInformation
End Sub

或者：

Option Explicit
Public Sub ClearCells()

    Const COLUMN_START1 As Long = 2
    Const COLUMN_END1 As Long = 5
    Const COLUMN_START2 As Long = 7
    Const COLUMN_END2 As Long = 10
    Const COLUMN_START3 As Long = 12
    Const COLUMN_END3 As Long = 15
    Const START_ROW As Long = 8
    'Const L_MY_DEFINED_NAME As String = "ID"

    Dim loopRanges()

    loopRanges = Array(COLUMN_START1, COLUMN_END1, COLUMN_START2, COLUMN_END2, COLUMN_START3, COLUMN_END3)

    Dim targetSheet As Worksheet, index As Long, unionRng As Range
    Dim id As Long                               'Or , ID As String?

    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
    'id = ThisWorkbook.Names(L_MY_DEFINED_NAME).RefersToRange.Value

    Dim ids()
    ids = targetSheet.Range("B3:B5").Value

    Application.ScreenUpdating = False

    With targetSheet

        For index = LBound(loopRanges) To UBound(loopRanges) Step 2

            Dim lngLastRow As Long, ClearRange As Range, rng As Range

            lngLastRow = .Cells(.Rows.Count, loopRanges(index)).End(xlUp).Row '
            If lngLastRow < START_ROW Then lngLastRow = START_ROW

            Set ClearRange = .Range(.Cells(START_ROW, loopRanges(index)), .Cells(lngLastRow, loopRanges(index + 1)))

            For Each rng In ClearRange.Columns(1).Cells
                If Not IsEmpty(rng) Then
                    If Not IsError(Application.Match(rng.Value, Application.WorksheetFunction.index(ids, 0, 1), 0)) Then 'Left$(rng.Value, Len(id)) = id Then '<== match found
                        If Not unionRng Is Nothing Then
                            Set unionRng = Union(unionRng, rng.Resize(1, ClearRange.Columns.Count)) '<== gather all matches into a union range

                        Else
                            Set unionRng = rng.Resize(1, ClearRange.Columns.Count)
                        End If
                    End If
                End If
            Next rng
        Next index
    End With

    If Not unionRng Is Nothing Then unionRng.ClearContents '<== or after Then: 'Debug.Print unionRng.Address' to check what is cleared
    Application.ScreenUpdating = True
MsgBox "Done", vbInformation
End Sub

在第一个答案中，您只需使用

查找包含ID的范围内的当前单元格值

If Not IsError(Application.Match(rng.Value, targetSheet.Range("B3:B5"), 0))

如果匹配，则将其添加到项目中以便以后清除。

在第二个答案中，您将ID放入数组中，并在循环时检查当前单元格值是否在数组中：

If Not IsError(Application.Match(rng.Value, Application.WorksheetFunction.index(ids, 0, 1), 0))

修改

如果您不知道它们的长度是否匹配，您可以扩展原始代码以循环所有ID，如下所示：

Option Explicit Public Sub ClearCells() Const COLUMN_START1 As Long = 2 Const COLUMN_END1 As Long = 5 Const COLUMN_START2 As Long = 7 Const COLUMN_END2 As Long = 10 Const COLUMN_START3 As Long = 12 Const COLUMN_END3 As Long = 15 Const START_ROW As Long = 8 'Const L_MY_DEFINED_NAME As String = "ID" Dim loopRanges() loopRanges = Array(COLUMN_START1, COLUMN_END1, COLUMN_START2, COLUMN_END2, COLUMN_START3, COLUMN_END3) Dim targetSheet As Worksheet, index As Long, unionRng As Range Dim id As Long 'Or , ID As String? Set targetSheet = ThisWorkbook.Sheets("Sheet1") 'id = ThisWorkbook.Names(L_MY_DEFINED_NAME).RefersToRange.Value Dim ids(), i As Long ids = targetSheet.Range("B3:B5").Value Application.ScreenUpdating = False With targetSheet For i = LBound(ids, 1) To UBound(ids, 1) For index = LBound(loopRanges) To UBound(loopRanges) Step 2 Dim lngLastRow As Long, ClearRange As Range, rng As Range lngLastRow = .Cells(.Rows.Count, loopRanges(index)).End(xlUp).Row ' If lngLastRow < START_ROW Then lngLastRow = START_ROW Set ClearRange = .Range(.Cells(START_ROW, loopRanges(index)), .Cells(lngLastRow, loopRanges(index + 1))) For Each rng In ClearRange.Columns(1).Cells If Not IsEmpty(rng) Then If Left$(rng.Value, Len(ids(i, 1))) = ids(i, 1) Then '<== match found If Not unionRng Is Nothing Then Set unionRng = Union(unionRng, rng.Resize(1, ClearRange.Columns.Count)) '<== gather all matches into a union range Else Set unionRng = rng.Resize(1, ClearRange.Columns.Count) End If End If End If Next rng Next index Next i End With If Not unionRng Is Nothing Then unionRng.ClearContents '<== or after Then: 'Debug.Print unionRng.Address' to check what is cleared Application.ScreenUpdating = True MsgBox "Done", vbInformation End Sub

Answer 2

“快速和肮脏”的代码：

Sub main()
    Dim iCol As Long
    Dim filters As Variant, filter As Variant
    Dim cell As Range

    filters = Array("1234", "432", "5544") '<- list your named ranges values

    With ThisWorkbook.Sheets("Sheet1")
        For iCol = 2 To 12 Step 5
            For Each cell In .Range(.Cells(8, iCol), .Cells(.Rows.count, iCol).End(xlUp))
                For Each filter In filters
                    If InStr(cell.Text, filter) > 0 Then
                        cell.Resize(, 4).ClearContents
                        Exit For
                    End If
                Next
            Next
        Next
    End With
End Sub

一个不太脏的代码，将迭代限制为实际的匹配数：

Sub main2()
    Dim iCol As Long
    Dim filters As Variant, filter As Variant
    Dim f As Range

    filters = Array("1234", "432", "5544")

    With ThisWorkbook.Sheets("Sheet001")
        For iCol = 2 To 12 Step 5
            With .Range(.Cells(8, iCol), .Cells(.Rows.count, iCol).End(xlUp))
                For Each filter In filters
                    Set f = .Find(what:=filter, LookIn:=xlValues, lookat:=xlPart)
                    If Not f Is Nothing Then
                        Do
                            f.Resize(, 4).ClearContents
                            Set f = .FindNext(f)
                        Loop While Not f Is Nothing
                    End If
                Next
            End With
        Next
    End With
End Sub

清除行＆＃39;数组中的内容 - 有3个条件

2 个答案: