Искатель другого значения в диапазоне VBA Excel - PullRequest
Новая
       0

Искатель другого значения в диапазоне VBA Excel

0 голосов
/ 08 апреля 2020

Я разрабатываю код предварительной последовательности VBA, который должен искать значение, введенное в строку (в этом случае строка Z начинается с Z4 и заканчивается на Z15), и должен проверять, существует ли он уже в другой строке (в этом случае строка AB, начинающаяся в AB4 и заканчивающаяся в AB15). Если он не существует, он должен поместить время в ячейку, соответствующую ячейке строки AB (например, Z4 -> AB4, Z5 -> AB5). Таким образом, я заверяю, что ни одна ячейка AB не содержит значения, равного другому значению AB (под значениями AB следует понимать места в строке с разницей в две минуты). Если он находит значение строки Z в строке AB, он должен добавить две минуты к значению Z и еще раз проверить, занято ли это «место», пока не найдет свободное место.

В В приведенном ниже коде вы можете увидеть повторяющийся оператор для каждого Z в строке, а в конце функция вызвала каждое из операторов.

ЭТОТ КОД РАБОТАЕТ, НО, иногда он имеет fl aws, я не знаю почему, когда времена не вводятся последовательно сверху вниз, возникает ошибка «Ошибка выполнения 457: этот ключ уже связан с элементом этой коллекции». и он подчеркивает утверждение «Dict.Add Hora, 1» в функции в конце кода, это похоже на определенный порядок введения данных, вызывающий ошибку. Я продолжаю вставлять изображение для более ясного понимания. Пример инструмента * 

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

1 Ответ

0 голосов
/ 10 апреля 2020

согласно вашему последнему комментарию вы можете попробовать изменить For Each C l oop в Function CargaHorasOcupadas() следующим образом: 

        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

, но я бы посоветовал вам:

  • сделать резервную копию ваших файлов

  • проверить код, пройдя по нему:

    • поставить точку останова ( F9) в строке Do While Dict.Exists(Hora)

    • как только код достигнет этой строки, используйте немедленное окно (CTRL-G, чтобы открыть его) и введите ?Hora, Dict.Exists(Hora) и нажмите ввод, чтобы увидеть результат

    • , если вы удовлетворены результатом, нажмите F8, чтобы перейти к следующему исполняемому утверждению

    • и т. Д.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...