Question

我有这个表格来输入新数据到表格。我想在用户输入已存在的发票号时发出警告。这是我的代码，但它不起作用：

Private Sub CommandButton1_Click()
Dim L As Long
Dim Code As String
Dim TextBox2 As Long
Dim valFormula As String
valFormula = "=COUNTIFS($F12:$F1702,F1702,$D12:$D1702,D1702)=1"

If MsgBox("Confirm?", vbYesNo, "Confirming new invoice") = vbYes Then
    With Worksheets("FACTURE")
        L = Sheets("FACTURE").Range("D65535").End(xlUp).Row + 1 'Pour placer     le nouvel enregistrement _ la premi_re ligne de tableau non vide
    End With
    With Me
        Range("D" & L).Validation
            .Add Type:=xlValidateCustom, _
            AlertStyle:=xlValidAlertWarning, _
            Formula1:="=COUNTIFS($F12:$F1702,F1702,$D12:$D1702,D1702)=1"
            .InputTitle = ""
            .ErrorTitle = "Duplicate alert"
            .InputMessage = ""
            .ErrorMessage = "This invoice number already exist. Continue?"

        Range("B" & L).Value = .ComboBox2 & .ComboBox3
        Range("C" & L).Value = (Now)
        Range("D" & L).Value = .TextBox2
        Range("E" & L).Value = .TextBox3
        Range("F" & L).Value = .TextBox4
        Range("G" & L).Value = .TextBox5
        Range("K" & L).Value = .ComboBox1
        Range("L" & L).Value = .ComboBox2
        Range("M" & L).Value = .ComboBox3
        Range("N" & L).Value = .TextBox9
        Range("O" & L).Value = .TextBox10
        Range("R" & L).Value = .TextBox39
        Range("P" & L).Value = .TextBox40
        Range("C" & L).Interior.ColorIndex = 0
        If .OptionButton1 Then
            FormatCell Range("B" & L), xlThemeColorAccent3
        ElseIf .OptionButton2 Then
            FormatCell Range("B" & L), xlThemeColorAccent1
        ElseIf .OptionButton3 Then
            FormatCell Range("B" & L), xlThemeColorAccent4
        Else
            FormatCell Range("B" & L), xlThemeColorAccent2
        End If
    End With
End If
End Sub

有什么建议吗？

Answer 1

正如共产国际建议的那样，使用Range对象的Find()方法，代码如下：

Set f = rngToSerachIn.Find(what:=factureNo, LookIn:=xlValues, lookat:=xlWhole)

，其中

f是一个范围变量，用于存储具有搜索值的范围
rngToSerachIn是搜索值的范围
factureNo是搜索

此外，在我看来，您的发票将存储在12个向下的行中，因此编写一个通用函数来获取给定工作表的给定列中的第一个空单元格（从某一行开始）

因为要求Sub / Function的特定任务来提高代码的可读性和维护是一个很好的做法，所以你可以这样做：

从给定工作表的给定列中的给定行开始，在最后一个非空行之后获取第一个空行
验证发票号
填写工作表范围
格式化发票单元格

如下：

Option Explicit

Private Sub CommandButton1_Click()
    Dim L As Long
    Dim factureWs As Worksheet

    If MsgBox("Confirm?", vbYesNo, "Confirming new invoice") = vbNo Then Exit Sub

    Set factureWs = Worksheets("FACTURE") '<--| set the worksheet you want to work with

    L = GetLastNonEmptyRow(factureWs, "D", 12) + 1 '<--| get passed worksheet first empty row after last non empty one in column "D" from row 12 (included)

    If L > 12 Then If Not CheckDuplicate(Me.TextBox2, factureWs.Range("D12:D" & L - 1)) Then Exit Sub '<--| exit if duplicated non accepted by the user

    FillRanges factureWs, L '<--| fill worksheet ranges with userfom controls values

    FormatInvoice factureWs.Range("B" & L) '<--| color invoice cell depending on option buttons values
End Sub

Function GetLastNonEmptyRow(ws As Worksheet, colIndex As String, firstRow As Long) As Long
    Dim lastRow As Long
    With ws
        lastRow = .Cells(.Rows.Count, colIndex).End(xlUp).row ' <--| get last non empty row in given column
        If lastRow = 1 Then If IsEmpty(.Range(colIndex & 1)) Then lastRow = 0  '<--| handle the case of an empty column
        If lastRow < firstRow Then lastRow = firstRow - 1 '<--| handle the case the last non empty row is above the first passed one
    End With
    GetLastNonEmptyRow = lastRow
End Function

Function CheckDuplicate(factureNo As String, rng As Range) As Boolean
    Dim f As Range
    Set f = rng.Find(what:=factureNo, LookIn:=xlValues, lookat:=xlWhole)
    If Not f Is Nothing Then
        CheckDuplicate = MsgBox("This invoice number already exist!" & vbCrLf & vbCrLf & "Continue?", vbExclamation + vbYesNo, "Duplicate alert") = vbYes
    Else
        CheckDuplicate = True
    End If
End Function

Sub FormatInvoice(rng As Range)
    Dim thColor As XlThemeColor

    With Me
        Select Case True
            Case .OptionButton1
                thColor = xlThemeColorAccent3
            Case .OptionButton2
                thColor = xlThemeColorAccent1
            Case .OptionButton3
                thColor = xlThemeColorAccent4
            Case Else
                thColor = xlThemeColorAccent2
        End Select
    End With
    FormatCell rng, thColor
End Sub

Sub FillRanges(ws As Worksheet, L As Long)
    With ws
        .Range("C" & L).Value = (Now)
        .Range("D" & L).Value = Me.TextBox2
        .Range("E" & L).Value = Me.TextBox3
        .Range("F" & L).Value = Me.TextBox4
        .Range("G" & L).Value = Me.TextBox5
        .Range("K" & L).Value = Me.ComboBox1
        .Range("L" & L).Value = Me.ComboBox2
        .Range("M" & L).Value = Me.ComboBox3
        .Range("N" & L).Value = Me.TextBox9
        .Range("O" & L).Value = Me.TextBox10
        .Range("R" & L).Value = Me.TextBox39
        .Range("P" & L).Value = Me.TextBox40
    End With
End Sub

您可能会发现它很有用，并在随后的编码中遵循此模式

VBA表单中的自定义数据验证

1 个答案: