моя подпрограмма над правилами my if, отображая пустую строку в моем сообщении - PullRequest
0 голосов
/ 26 декабря 2018

Я динамически обновляю ячейки в столбцах A и B, объединяю оба значения в каждой строке (используя &) и помещаю значения в столбец c.

Моя цель достигается путем обнаружения повторяющихся имен, когда firstName (Значения ColumnA) и LastName (значения columnB) вводятся дважды.Однако во время моего тестирования я понял, что пустое значение (наблюдаемое при отображении msgbox) всегда появляется, когда я удаляю повторяющееся имя, за которым следует первое вхождение.

это иногда проблема, особенно потому, что иногдаmsgbox не уходит .... т.е. код вылетает.

Может кто-нибудь помочь мне предотвратить пустое значение или отображение формы msgBox?Я подозреваю, что с моим утверждением if что-то не так.

Большое спасибо.

вот код VBA, который я поместил в лист

Private Sub Worksheet_Change(ByVal Target As Range)

If WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 1).Value) > 1 And _
Target.Offset(0, 1).Value <> " " Then
    MsgBox Target.Offset(0, 1).Value & " is a Duplicate Entry" & vbNewLine & _
    " ENTER A NEW NAME", vbInformation, "Duplicate Detected"
    Target.Offset(0, 0).Value = " "
    Target.Offset(0, 0).Select
ElseIf WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 2).Value) > 1 And _
Target.Offset(0, 1).Value <> " " Then
    MsgBox Target.Offset(0, 2).Value & " is a Duplicate Entry" & vbNewLine & _
    " ENTER A NEW NAME", vbInformation, "Duplicate Detected"
    Target.Offset(0, 0).Value = " "
    Target.Offset(0, 0).Select
Else: Exit Sub
End If

End Sub

1 Ответ

0 голосов
/ 26 декабря 2018

Если бы я хотел создать лист с

-2        -1       0
ColA      ColB     ColC
First1    Last1    First1Last1
First2    Last2    First2Last2
First3    Last3    First3Last3
First4    Last4

, я бы лично начал с условного форматирования для ColC, чтобы пометить, что является дубликатом, в случае, если есть проблема, которая обходит окно сообщения.

Если бы мне нужен был ящик сообщений, я бы настроил так, как у вас:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns(3)) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Application.CountIfs(Range("C1:C12"),Target.Value) > 1 Then 'checks for first/last name
        MsgBox("The name " & Target.Offset(0,-2).Value & " " & Target.Offset(0,-1).Value & " already exists." & vbNewLine & "Please enter a new name.")
    End If
End Sub

Edit1:

Учитываяввод данных для colA и colB, будет ли это более уместным?Я использовал строку цели, поэтому отрицательное смещение не должно вызывать беспокойства, поскольку вы знаете, что colA - это имя, а colB - это фамилия.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Dim r as long
    r = target.row
    If isempty(cells(r,1)) or isempty(cells(r,2)) then exitsub
    If Application.CountIfs(Range("B1:B12"),cells(r,2).Value,Range("A1:A12"),cells(r,1).Value) > 1 Then 'checks for first/last name
        MsgBox("The name " & cells(r,1).Value & " " & cells(r,2).Value & " already exists." & vbNewLine & "Please enter a new name.")
    End If
End Sub

Edit2:

При проверке использования без значений и некоторых значений этот макрос работал для моего тестирования (я добавил чистое содержимое и .select, чтобы вы вернулись на линию, которую следует добавлять данные);я также добавил спецификацию диапазона, связанную с пересечением, в случае, если вы добавляете значения, такие как first / last, в случайное место за пределами a1: b12:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range(Cells(1, 1), Cells(12, 2))) Is Nothing Then Exit Sub
    Dim r As Long
    r = Target.Row
    If IsEmpty(Cells(r, 1)) Or IsEmpty(Cells(r, 2)) Then Exit Sub
    If Application.CountIfs(Range("B1:B12"), Cells(r, 2).Value, Range("A1:A12"), Cells(r, 1).Value) > 1 Then 'checks for first/last name
        MsgBox ("The name " & Cells(r, 1).Value & " " & Cells(r, 2).Value & " already exists." & vbNewLine & "Please enter a new name.")
        Cells(r, 1).ClearContents
        Cells(r, 2).ClearContents
        Cells(r, 1).Select
    End If
End Sub
...