Range VBA excel中另一个值的搜索器答案

【问题标题】：Searcher of another value in a Range VBA excelRange VBA excel中另一个值的搜索器
【发布时间】：2020-04-08 08:45:16
【问题描述】：

我正在设计一个预排序 VBA 代码，它必须寻找一行中引入的值（在这种情况下，行 Z 从 Z4 开始并以 Z15 结束）并且必须验证它是否已经存在于另一行中（在这种情况下AB 行从 AB4 开始，以 AB15 结束）。如果不存在，则必须将时间放在 AB 行对应的单元格中（例如 Z4 --> AB4，Z5 --> AB5）。这是我确保没有 AB 单元格包含等于另一个 AB 值的值的一种方式（将 AB 值理解为具有两分钟差异的连续位置）。如果在 AB 行中找到 Z 行的值，则必须在 Z 值上增加两分钟，并再次检查该“位置”是否已被占用，直到找到空闲位置。

在下面的代码中，您可以看到一行中每个 Z 的重复语句，最后函数调用了每个语句。

此代码确实有效，但有时它有缺陷，我不知道为什么，当时间没有从上到下依次引入时，它会带来错误“运行时错误 457：此键已与这个系列。”并且它确实在代码末尾的函数中强调了语句“Dict.Add Hora，1”，这就像以某种方式引入数据的特定顺序触发了错误一样。我继续插入图像以进行更多说明。 Tool ilustration Example

Private Sub Worksheet_Change(ByVal Target As Range)
Dim HoraStr As String
Dim HorasOcupadas As Object: Set HorasOcupadas = CargaHorasOcupadas
Dim HoraDeseada As Date
Dim HoraOcupada As Boolean: HoraOcupada = HorasOcupadas.Exists(HoraStr)
Dim lrow4: lrow4 = Range("Z4").Row
Dim lrow5: lrow5 = Range("Z5").Row
Dim lrow6: lrow6 = Range("Z6").Row
Dim lrow7: lrow7 = Range("Z7").Row
Dim lrow8: lrow8 = Range("Z8").Row
Dim lrow9: lrow9 = Range("Z9").Row
Dim lrow10: lrow10 = Range("Z10").Row
Dim lrow11: lrow11 = Range("Z11").Row
Dim lrow12: lrow12 = Range("Z12").Row
Dim lrow13: lrow13 = Range("Z13").Row
Dim lrow14: lrow14 = Range("Z14").Row
Dim lrow15: lrow15 = Range("Z15").Row
If Target.Address = "$Z$4" Then
Sheets("Hoja1").Range("Z4").Copy Destination:=Sheets("Tips").Range("C9")
Sheets("Hoja1").Range("Z4").Copy
Sheets("Tips").Range("K3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z4").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow4, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$5" Then
Sheets("Hoja1").Range("Z5").Copy Destination:=Sheets("Tips").Range("C10")
Sheets("Hoja1").Range("Z5").Copy
Sheets("Tips").Range("K4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z5").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow5, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$6" Then
Sheets("Hoja1").Range("Z6").Copy Destination:=Sheets("Tips").Range("C11")
Sheets("Hoja1").Range("Z6").Copy
Sheets("Tips").Range("K5").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z6").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$7" Then
Sheets("Hoja1").Range("Z7").Copy Destination:=Sheets("Tips").Range("C12")
Sheets("Hoja1").Range("Z7").Copy
Sheets("Tips").Range("K6").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z7").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$8" Then
Sheets("Hoja1").Range("Z8").Copy Destination:=Sheets("Tips").Range("C13")
Sheets("Hoja1").Range("Z8").Copy
Sheets("Tips").Range("K7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z8").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$9" Then
Sheets("Hoja1").Range("Z9").Copy Destination:=Sheets("Tips").Range("C14")
Sheets("Hoja1").Range("Z9").Copy
Sheets("Tips").Range("K8").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z9").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$10" Then
Sheets("Hoja1").Range("Z10").Copy Destination:=Sheets("Tips").Range("C15")
Sheets("Hoja1").Range("Z10").Copy
Sheets("Tips").Range("K9").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z10").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$11" Then
Sheets("Hoja1").Range("Z11").Copy Destination:=Sheets("Tips").Range("C16")
Sheets("Hoja1").Range("Z11").Copy
Sheets("Tips").Range("K10").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z11").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$12" Then
Sheets("Hoja1").Range("Z12").Copy Destination:=Sheets("Tips").Range("C17")
Sheets("Hoja1").Range("Z12").Copy
Sheets("Tips").Range("K11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z12").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$13" Then
Sheets("Hoja1").Range("Z13").Copy Destination:=Sheets("Tips").Range("C18")
Sheets("Hoja1").Range("Z13").Copy
Sheets("Tips").Range("K12").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z13").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$14" Then
Sheets("Hoja1").Range("Z14").Copy Destination:=Sheets("Tips").Range("C19")
Sheets("Hoja1").Range("Z14").Copy
Sheets("Tips").Range("K13").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z14").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
ElseIf Target.Address = "$Z$15" Then
Sheets("Hoja1").Range("Z15").Copy Destination:=Sheets("Tips").Range("C20")
Sheets("Hoja1").Range("Z15").Copy
Sheets("Tips").Range("K14").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
HoraDeseada = Range("Z15").Value
    HoraStr = Format(HoraDeseada, "hh:mm")
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With
    End If
End Sub

Private Function CargaHorasOcupadas() As Object
Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    Dim lrow As Long: lrow = .Cells(.Rows.Count, "AB").End(xlUp).Row
    If lrow > 3 Then
        Dim C As Range
        Dim Hora As String
        For Each C In .Range("AB4:AB" & lrow)
            Hora = Format(C, "hh:mm")
            Dict.Add Hora, 1
        Next C
    End If
End With
Set CargaHorasOcupadas = Dict

End Function

【问题讨论】：

Dict.Add Hora, 1 抛出的错误告诉您Sheets("Hoja1") 中的Range("AB4:AB" & lrow) 有一些重复项。也许切换到“hh：mm.ss”格式可以防止它。在任何情况下，您都可以将Dict.Add Hora, 1 更改为If Dict.Exists(Hora) Then - MsgBox Hora & "duplicated in " & C.Address - Else - Dict.Add Hora, 1 - End If（其中连字符代表新代码行）并在实际存在时捕获可能的重复项
我尝试更改格式，但没有成功。但是，您提供的更正会捕获重复项，并使弹出窗口稳定。问题是，我不需要弹出窗口，如果发生这种情况，我需要它添加两分钟并再次检查，我尝试使用 dateadd("n",2;"Hora") 并且同样的错误不断出现
你把dateadd("n",2;"Hora")放在哪里了？抛出了什么错误，在哪一行？
完全没有报错，但是没有加上时间，它在一个单元格中显示之前或之后重复的相同值。我这样放置If Dict.Exists(Hora) Then - Hora = DateAdd("n", 2, Hora) - Else - Dict.Add Hora, 1 - End If
按照我的回答试试代码

标签： excel vba

【解决方案1】：

根据您的最后评论，您可以尝试更改 Function CargaHorasOcupadas() 中的 For Each C 循环，如下所示：

        For Each C In .Range("AB4:AB" & lrow)
            Hora = Format(C, "hh:mm")
            Do While Dict.Exists(Hora)' if 'Hora' already in dictionary
                Hora = DateAdd("n", 2, Hora)' update 'Hora' by adding two minutes
            Loop' go to initial check 
            Dict.Add Hora, 1'once here you shoudl have a brand new 'Hora with no duplicates in Dict 
        Next C

但我建议你：

制作文件的备份副本
通过逐步测试代码：
- 在Do While Dict.Exists(Hora)行处放一个断点（F9）
- 一旦代码到达该行，使用即时窗口（CTRL-G 将其弹出）并输入?Hora, Dict.Exists(Hora) 并按回车键查看结果
- 如果您对结果满意，请按 F8 进入下一个可执行状态
- 等等

【讨论】：

它实际上调试了问题，但结果不正确，它没有添加2分钟，它返回了引入的时间......我不知道为什么
你按照我的建议测试了吗？（请参阅文本 “通过逐步测试代码：”）
您在我的回答中实际使用过代码吗？您在问题下方的最后一条评论没有使用它……
是的，我一步一步做到了，结果是引入的时间，在运行“Do While”之前和之后，我认为现在问题在于 lrow 定义，让我解释一下。我认为通过定义几个 lrow，该功能无法正常工作。尽管如此，我还是尝试对每个单元格使用一个 lrow 定义来进行修改，在这种情况下，会弹出错误“运行时错误'13'：类型不匹配'，强调'Hora = DateAdd("n", 2, Hora ) ' 更新 'Hora' 通过添加两分钟' 行
现在正在运行吗？