excel VBA循环不是整个范围,但对于特定单元格(范围)排除某些单元格

busg9geu  于 2023-01-27  发布在  其他
关注(0)|答案(1)|浏览(213)

我写了下面的代码。它工作,但是,我想修改这一行
设置rng =应用程序交集(目标、中间范围(“M30:AM53”))如果不是rng为空,则仅循环通过M30:AM53中的任何单元格
不是整个范围(M30:AM53),而是特定范围。水平方向M31:O33,Q31:S33,......共重复7次。垂直方向M31:O33,M35:O37,......重复6次。
如有任何意见和建议,我们将不胜感激。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim trlRed As Long, oPhoneBlue As Long, adrGreen As Long, iosGrey As Long, cmnPurple As Long
    Dim rng As Range, cell As Range

    trlRed = RGB(230, 37, 30)
    oPhoneBlue = RGB(126, 199, 216)
    adrGreen = RGB(61, 220, 132)
    iosGrey = RGB(162, 170, 173)
    cmnPurple = RGB(165, 154, 202)

    'firstLvValFor = Array("TRIAL", "BEGINNER", "NOVICE", "INTERMEDIATE", "ADVANCED")
    secondLvValFor = Array("aaa", "bbb", "ccc", "ddd")

    thirdLvValFor_01 = Array("Basic", "Text", "PhoneCall", "mail", "camera")
    thirLvValFor_02 = Array("Security", "WhatsApp", "Wi-Fi")
    

    Set rng = Application.Intersect(Target, Me.Range("M30:AM53"))
    If Not rng Is Nothing Then 'only loop though any cells in M30:AM53
        For Each cell In rng.Cells
            If cell.Value = "Session" And cell.Offset(0, -2).Value = "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = trlRed

            ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "aaa" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = oPhoneBlue

            ElseIf cell.Value = "aaa" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = oPhoneBlue

            ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "bbb" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = adrGreen

            ElseIf cell.Value = "bbb" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = adrGreen ' I mistook following code cell.offset(0, 1) = value, this was wrong. The correct form is offset(0, 1).value. This works perfectly. 01/23/23 14:08

            ElseIf IsError(Application.Match(cell.Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value = "ccc" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = iosGrey

            ElseIf cell.Value = "ccc" And IsError(Application.Match(cell.Offset(0, 1).Value, thirdLvValFor_01, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = iosGrey

            ElseIf IsError(Application.Match(cell.Value, thirLvValFor_02, 0)) = False And cell.Offset(0, -1).Value = "ddd" And cell.Offset(0, -2).Value <> "TRIAL" Then
                cell.Offset(0, -2).Resize(1, 3).Interior.Color = cmnPurple

            ElseIf cell.Value = "ddd" And IsError(Application.Match(cell.Offset(0, 1).Value, thirLvValFor_02, 0)) = False And cell.Offset(0, -1).Value <> "TRIAL" Then
                cell.Offset(0, -1).Resize(1, 3).Interior.Color = cmnPurple


            Else
                cell.Interior.ColorIndex = xlColorIndexNone
            End If
        Next cell
    End If
End Sub

为了在代码运行时锁定一些单元格,我必须更精确地修改范围。在范围(M30:AM53)内,我希望定期将函数应用于不相邻的单元格(范围)。在这种情况下,应该排除上面的1个单元格,下面的1个单元格,右边的1个单元格。我提前感谢大家。

km0tfn4u

km0tfn4u1#

below函数从区域中删除某些单元格,但保留区域的其余部分。

Function ExceptRange(Rng As Range, Except As Range) As Range
Dim a As Long, Confirmed() As Range
For a = 1 To Rng.Cells.Count
    If Intersect(Rng.Cells(a), Except) Is Nothing Then
        If ExceptRange Is Nothing Then
            Set ExceptRange = Rng.Cells(a)
        Else
            Set ExceptRange = Union(ExceptRange, Rng.Cells(a))
        End If
    End If
Next
End Function

如果在sub中调用它,可以在循环之前从rng中删除不需要的单元格,这样For Each cell in Rng就会自动跳过已删除的单元格。

相关问题