在时间范围内查找string

我如何在同一date或第二天的时间范围内突出显示重复的零件编号？

1qwerty 2017-02-28 2qwerty 2017-02-26 3qwerty 2017-02-21 4qwerty 2017-02-21 4qwerty 2017-02-21 5qwerty 2017-02-21 2qwerty 2017-02-20 3qwerty 2017-02-20 5qwerty 2017-02-20 6qwerty 2017-02-19 

因此，在这种情况下，第5,8,9行会在同一天或正在search的部件号的第二天内突出显示。 我需要创build一个循环，这将为每一行，可能100行。

这里有一些更多的数据，一个是作为突出显示，并没有工作的地方，应该被强调，谢谢

  2017-02-27 1qwerty Highlighted 2017-02-27 2qwerty 2017-02-27 1qwerty 2017-02-27 3qwerty 2017-02-27 4qwerty 2017-02-27 5qwerty 2017-02-27 6qwerty 2017-02-24 5qwerty 2017-02-23 14qwerty 2017-02-23 15qwerty 2017-02-23 16qwerty 2017-02-23 14qwerty Highlighted 2017-02-22 17qwerty 2017-02-22 1qwerty 2017-02-21 14qwerty 2017-02-21 19qwerty 2017-02-20 6qwerty 2017-02-20 20qwerty 2017-02-20 21qwerty 2017-02-20 19qwerty Highlighted 2017-02-20 1qwerty 2017-02-17 5qwerty 2017-02-17 14qwerty 2017-02-17 1qwerty 2017-02-17 22qwerty 2017-02-17 23qwerty 2017-02-17 1qwerty Should be Highlighted 2017-02-17 19qwerty 2017-02-17 1qwerty Should be Highlighted 2017-02-16 24qwerty 2017-02-16 25qwerty 2017-02-16 26qwerty 2017-02-16 27qwerty 2017-02-16 28qwerty 2017-02-16 1qwerty 2017-02-16 24qwerty Highlighted 2017-02-16 29qwerty 2017-02-15 1qwerty 2017-02-07 6qwerty Should be Highlighted 2017-02-07 6qwerty 2017-02-07 30qwerty 2017-02-07 31qwerty 2017-02-07 19qwerty 2017-02-07 32qwerty 2017-02-06 6qwerty 2017-02-01 33qwerty 2017-02-01 33qwerty Should be Highlighted 2017-02-01 34qwerty 

任何帮助都非常感激，一如既往！

Answer 1

如果您按顺序（升序或降序）保持date，并且如果您不保留date，那么这不是一件困难的事情 – 只要先sorting就可以了！

所以让我们按照您的数据示例降序排列！ 我在这种情况下的input如下所示：

请注意，在我的例子中，我使用字典对象跟踪项目，我search。

要使用字典对象，您需要参考Microsoft脚本运行时！

例程 ：

 Option Explicit Sub Test() Dim WS As Worksheet Dim DataRange As Range Dim DataDict As Dictionary Dim RawData As Variant Dim CurrentSearch As Range Dim TestPrevSearch As Range Dim FirstSearch As Range Dim CurrentDate As Date Dim LastRow As Long Dim i As Long Dim DebMsg As String Set WS = ActiveSheet 'or whatever sheet your want Set DataDict = New Dictionary 'setting-up a dictionary With WS LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row Set DataRange = .Range("A1:A" & LastRow) End With RawData = Application.Transpose(DataRange) 'transposing raw data If Not IsArray(RawData) Then _ Exit Sub 'iterating over each qwerties For i = LBound(RawData) To UBound(RawData) Debug.Print "Search for " & RawData(i) If Not DataDict.Exists(RawData(i)) Then 'Get first search Set TestPrevSearch = Nothing Set CurrentSearch = DataRange.Find(What:=RawData(i), LookIn:=xlValues, SearchDirection:=xlNext, _ LookAt:=xlWhole, SearchOrder:=xlByRows, _ MatchCase:=False, SearchFormat:=False) If Not CurrentSearch Is Nothing Then 'Maybe it's a bug - but sometimes it's start search from second occurence... Set TestPrevSearch = DataRange.FindPrevious(After:=CurrentSearch) If Not TestPrevSearch Is Nothing Then If TestPrevSearch.Row < CurrentSearch.Row Then Debug.Print "Bug search fixed......" Set CurrentSearch = TestPrevSearch End If End If CurrentDate = CurrentSearch.Offset(ColumnOffset:=1).Value Debug.Print vbTab & "Found in " & CurrentSearch.Address & vbTab & vbTab & "Date is " & CurrentDate _ & vbTab & vbTab & "Reference date" Call DataDict.Add(Key:=RawData(i), Item:=CurrentDate) Set FirstSearch = CurrentSearch Do 'Get next search in loop Set CurrentSearch = DataRange.FindNext(After:=CurrentSearch) If Not CurrentSearch Is Nothing Then If CurrentSearch.Address = FirstSearch.Address Then Exit Do Else CurrentDate = CurrentSearch.Offset(ColumnOffset:=1).Value DebMsg = vbTab & "Found in " & CurrentSearch.Address & vbTab & vbTab & "Date is " & CurrentDate 'If CurrentDate older then date in a dict If CurrentDate < DataDict(RawData(i)) Then 'Check if it was yesterday (if you need to check for tomorrow - get rid off "-" sign) If CurrentDate = DateAdd("d", -1, DataDict(RawData(i))) Then CurrentSearch.Interior.ColorIndex = 3 DebMsg = DebMsg & vbTab & vbTab & "Highlighted (Yesterday to reference)" 'If it even older... Else DataDict(RawData(i)) = CurrentDate DebMsg = DebMsg & vbTab & vbTab & "New Reference (Older then reference)" End If 'If Dates are equal ElseIf CurrentDate = DataDict(RawData(i)) Then CurrentSearch.Interior.ColorIndex = 3 DebMsg = DebMsg & vbTab & vbTab & "Highlighted (Equal to reference)" 'Rewrite date in dictionary if younger Else DataDict(RawData(i)) = CurrentDate DebMsg = DebMsg & vbTab & vbTab & "New Reference (Younger then reference)" End If Debug.Print DebMsg End If Else Exit Do End If Loop End If Else Debug.Print vbTab & "already found" End If Next End Sub 

输出 ：

奖金输出 （检查您的直接）：

这将有助于如果你要编辑我的逻辑！

总结 ：

1. 迭代qwerty条目而不是100行显着更快！
2. 我们需要（不是真的，但是sorting后的数据更容易）先sorting数据！

有用的链接 ：

vba有字典结构吗？

在Excel VBA中find和find下一个

查找最后一行，列或最后一个单元格