在Range VBA excel中搜索另一个值

Question

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

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

这个代码确实有效，但有时它也有缺陷，我不知道为什么，当时间没有按从上到下的顺序引入时，会出现错误"运行时错误457:这个键已经与这个集合的一个元素关联。"，这就像某种程度上，引入数据的特定顺序会触发错误。我将插入一张图片，以便进一步澄清。工具故障示例

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

Answer 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)并按enter键查看结果

  • 如果您对结果感到满意，请按F8进入下一个可执行状态

  • 等等