Option Explicit
Sub 同一编号有类型1和类型2则对类型1标红()
Dim arr(), i%, ii%, sType1$, sType2$, hasType1 As Boolean, hasType2 As Boolean, dic As Object
Dim h1%, h2%, curID$ 'h1表示当前编号的开始行号,h2 表示当前编号的结束行号
ThisWorkbook.Worksheets("基础表").Activate
Set dic = CreateObject("Scripting.Dictionary") '字典用于储存每一行的类型,1代表类型1,2代表类型2
'arr = ThisWorkbook.Worksheets("基础表").Range().currengregion.Value sType1 = "仓储、运输、物流"
sType2 = "仓供应、物管理"
hasType1 = False
hasType2 = False
curID = Range("A2").Value
'curID = ""
h1 = 2
For i = 2 To Range("A65536").End(xlUp).Row + 1 '留出个空行用行捕捉转折另一个编号的行号,(如果从3开始,则第二行没加入字典老是被路过没标色)
'字典确定类型:
If InStr(sType1, Cells(i, 6).Value) Then
dic.Add i, 1
ElseIf InStr(sType2, Cells(i, 6).Value) Then
dic.Add i, 2
Else
dic.Add i, 0
End If
If Cells(i, 1).Value <> curID Then '编号变化,开始处理这一行以上的区域的标色工作
h2 = i - 1
'为了找出当前编号是否同时拥有类型1和类型2
For ii = h1 To h2
If InStr(sType1, Cells(ii, 6).Value) Then
hasType1 = True
ElseIf InStr(sType2, Cells(ii, 6).Value) Then
hasType2 = True
End If
Next ii
'标色:
If hasType1 And hasType2 Then '同时有类型1和类型2
For ii = h1 To h2
If dic(ii) = 1 Then
Cells(ii, 1).Interior.Color = vbRed
Cells(ii, 4).Interior.Color = vbRed
Cells(ii, 6).Interior.Color = vbRed
End If
Next ii
'标色完成后,变量归于原始状态:
hasType1 = False
hasType2 = False
End If
h1 = i
curID = Cells(i, 1).Value
End If
Next i
End Sub