Excel VBA - 迭代所有行并突出显示相同特定字符中的所有行

时间:2017-11-07 06:45:16

标签: excel vba excel-vba loops iteration

我有一个看起来像这样的excel文件(A和Z替换为实际数据):

1    ===
2    AAAAAAAAAAAAAAAA
3    AAAAAAAAAAAAAAAA
4    AAAAAAAAAAAAAAAA
5    AAAAAAAAAAAAAAAA
6    AAAAAAAAAAAAAAAA
7    ===
8    ZZZZZZZZZZZZZZZZ
9    ZZZZZZZZZZZZZZZZ
10    ZZZZZZZZZZZZZZZZ
11    ZZZZZZZZZZZZZZZZ
12    ZZZZZZZZZZZZZZZZ
13    ===
14    AAAAAAAAAAAAAAAA
15    AAAAAAAAAAAAAAAA
16    AAAAAAAAAAAAAAAA
17    AAAAAAAAAAAAAAAA
18    AAAAAAAAAAAAAAAA
19    AAAAAAAAAAAAAAAA
20    AAAAAAAAAAAAAAAA
21    AAAAAAAAAAAAAAAA
22    ===
23    ZZZZZZZZZZZZZZZZ
24    ZZZZZZZZZZZZZZZZ
25    ZZZZZZZZZZZZZZZZ
26    ZZZZZZZZZZZZZZZZ
27    ZZZZZZZZZZZZZZZZ
28    ===
29    AAAAAAAAAAAAAAAA
30    AAAAAAAAAAAAAAAA
31    AAAAAAAAAAAAAAAA
32    AAAAAAAAAAAAAAAA
33    ===
34    ZZZZZZZZZZZZZZZZ
35    ZZZZZZZZZZZZZZZZ

我需要能够遍历所有n行并突出显示“===”分隔符中包含的所有行。这意味着我需要能够突出显示以下几行:1-7,13-22和28-33。 (即分隔符的每个“奇数”实例都是开头,每个“偶数”实例都是结尾)。

我正在考虑设置一个标志变量,以便在遇到第一个分隔符时打开,然后在下一个分隔符再次关闭,然后再次打开,依此类推,但我无法正确切换它。

任何人都可以分享一些代码段能够突出显示必要的行吗?

2 个答案:

答案 0 :(得分:1)

有几种方法可以实现这一目标。其中之一是:

Option Explicit 'force variable declaring

Sub MarkSomeData()
Dim iCounter As Integer
Dim iStart As Integer, iEnd As Integer
Dim wsh As Worksheet

'working sheet
Set wsh = ThisWorkbook.Worksheets(1)

iCounter = 1
Do While wsh.Range("A" & iCounter) <> ""
    If wsh.Range("A" & iCounter) = "===" Then
        If iStart = 0 Then iStart = iCounter
        If iEnd <= iStart Then iEnd = iCounter
        If iEnd > iStart Then
            wsh.Range("A" & iStart & ":A" & iEnd).Font.Color = vbRed
            iStart = 0
            iEnd = 0
        End If
    End If
    iCounter = iCounter + 1
Loop

Set wsh = Nothing

End Sub

随意根据您的需要更改代码。

祝你好运!

答案 1 :(得分:1)

请尝试此代码。如果您有列标题,请注意您可以指定要处理的列和第一行搜索分隔符。

Sub GroupData()
    ' 07 Nov 2017

    Const SearchColumn As String = "B"          ' change as appropriate
    Const FirstRow As Long = 1                  ' change as appropriate

    Dim Rl As Long                              ' last row
    Dim Rmark As Long
    Dim Counter As Integer
    Dim Rstart As Long

    With ActiveSheet
        Rl = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row
        Rmark = FindRow(Range(Cells(FirstRow, SearchColumn), Cells(Rl, SearchColumn)))
        Do While Rmark
            Counter = Counter + 1
            If Counter Mod 2 Then
                Rstart = Rmark + 1
            Else
                .Range(.Cells(Rstart, SearchColumn), _
                       .Cells(Rmark - 1, SearchColumn)).Interior.Color = vbYellow
            End If
            Rmark = FindRow(Range(Cells(Rmark + 1, SearchColumn), Cells(Rl, SearchColumn)))
        Loop
    End With
End Sub

Function FindRow(Rng As Range) As Long
    ' 06 Nov 2017
    ' return 0 if not found

    Dim Fnd As Range

    With Rng
        Set Fnd = .Find(What:="===", _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False, _
                        MatchByte:=False)
    End With
    If Not Fnd Is Nothing Then FindRow = Fnd.Row
End Function