Question

我有一个USerForm用于患者注册，在UserForm中有一个组合框用于选择主要医生我希望根据医生的选择生成患者ID，我甚至不知道从哪里开始我想要代码到评估哪个是具有相同前缀的最后一个ID来生成下一个ID，例如

KT000001
KT000002
LG000001

这是UserForm代码

Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Lista Pacientes")

'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'check for a Valid patient name
If Trim(Me.TextBox1.Value) = "" Then
  Me.TextBox1.SetFocus
  MsgBox "Favor Introducir Nombre"
  Exit Sub
End If

With ws
  .Cells(iRow, 2).Value = Me.TextBox1.Value
  .Cells(iRow, 3).Value = Me.TextBox2.Value
  .Cells(iRow, 4).Value = Me.TextBox3.Value
  .Cells(iRow, 5).Value = Me.TextBox4.Value
  .Cells(iRow, 7).Value = Me.TextBox5.Value
  .Cells(iRow, 8).Value = Me.TextBox6.Value
  .Cells(iRow, 10).Value = Me.TextBox7.Value
  .Cells(iRow, 11).Value = Me.TextBox8.Value
  .Cells(iRow, 12).Value = Me.TextBox9.Value
  .Cells(iRow, 13).Value = Me.TextBox10.Value
  .Cells(iRow, 14).Value = Me.TextBox11.Value
  .Cells(iRow, 15).Value = Me.TextBox12.Value
  .Cells(iRow, 16).Value = Me.TextBox13.Value
  .Cells(iRow, 17).Value = Me.ComboBox1.Value
  .Cells(iRow, 6).FormulaLocal = "=CONCATENAR(LIMPIAR(ESPACIOS(B" & iRow & "));SI(LIMPIAR(ESPACIOS(C" & iRow & "))="""";"""";"" "");LIMPIAR(ESPACIOS(C" & iRow & "));SI(LIMPIAR(ESPACIOS(D" & iRow & "))="""";"""";"" "");LIMPIAR(ESPACIOS(D" & iRow & "));SI(LIMPIAR(ESPACIOS(E" & iRow & "))="""";"""";"" "");LIMPIAR(ESPACIOS(E" & iRow & ")))"
  .Cells(iRow, 9).FormulaLocal = "=SIFECHA(H" & iRow & ";HOY();""Y"")"


End With

'clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.TextBox7.Value = ""
Me.TextBox8.Value = ""
Me.TextBox9.Value = ""
Me.TextBox10.Value = ""
Me.TextBox11.Value = ""
Me.TextBox12.Value = ""
Me.TextBox13.Value = ""
Me.ComboBox1.Value = ""
Me.TextBox1.SetFocus

Unload Me

End Sub

Private Sub CommandButton2_Click()
  Unload Me
End Sub

Answer 1

你可以像下面这样（注意评论）：

Option Explicit

Private Sub CommandButton1_Click()
    Dim iRow As Long
    Dim ws As Worksheet

    Dim IDCol As Long '<~~ this will hold the unique patient ID column index
    Dim nDoc As Long '<~~ this will count the number of occurrences of the chosen doctor ID in the patient ID column
    Dim docID As String '<~~ this will holed the doctor ID value (retrieved from ComboBox1)


    'check for a Valid patient name. <~~ do that at the beginning of the sub, not to run code uselessly
    If Trim(Me.TextBox1.Value) = "" Then
      Me.TextBox1.SetFocus
      MsgBox "Favor Introducir Nombre"
      Exit Sub
    End If

    IDCol = 17 '<~~ this is the column index where to write unique patient IDs. change it to your needs
    docID = Me.ComboBox1.Value '<~~ retrieve the doctor ID value from ComboBox1
    Set ws = Worksheets("Lista Pacientes")
    With ws
        'find first empty row in database
        iRow = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

        nDoc = WorksheetFunction.CountIf(.Cells(1, IDCol).Resize(iRow), docID & "*") '<~~ count the number of occurrences of the chosen doctor ID in the patient ID column
        .Cells(iRow, IDCol).Value = docID & Format(nDoc + 1, "000000") '<~~ write patient unique ID

        '...rest of your code here
    End With

    '...rest of your code here
End Sub

Answer 2

这是我最后的工作代码

Private Sub CommandButton1_Click()
Dim iRow As Long
Dim IDCol As Long
Dim nDoc As Long
Dim docID As String
Dim ws As Worksheet
Set ws = Worksheets("Lista Pacientes")

'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'check for a valid patient first name
If Trim(Me.TextBox1.Value) = "" Then
  Me.TextBox1.SetFocus
  MsgBox "Favor Introducir Nombre"
  Exit Sub
End If

'copy the data to the database

IDCol = 1

Select Case Me.ComboBox1.Value
    Case Is = "Dra. Lilaruth Gonzalez Montenegro"
        docID = "LG"
    Case Is = "Dr. Keneth Algo"
        docID = "KP"
    Case Is = "Dra. Aida Espinoza"
        docID = "AE"


End Select

With ws
nDoc = WorksheetFunction.CountIf(.Cells(1, IDCol).Resize(iRow), docID & "*")
.Cells(iRow, IDCol).Value = docID & Format(nDoc + 1, "000000")

  .Cells(iRow, 2).Value = Me.TextBox1.Value
  .Cells(iRow, 3).Value = Me.TextBox2.Value
  .Cells(iRow, 4).Value = Me.TextBox3.Value
  .Cells(iRow, 5).Value = Me.TextBox4.Value
  .Cells(iRow, 7).Value = Me.TextBox5.Value
  .Cells(iRow, 8).Value = Me.TextBox6.Value
  .Cells(iRow, 10).Value = Me.TextBox7.Value
  .Cells(iRow, 11).Value = Me.TextBox8.Value
  .Cells(iRow, 12).Value = Me.TextBox9.Value
  .Cells(iRow, 13).Value = Me.TextBox10.Value
  .Cells(iRow, 14).Value = Me.TextBox11.Value
  .Cells(iRow, 15).Value = Me.TextBox12.Value
  .Cells(iRow, 16).Value = Me.TextBox13.Value
  .Cells(iRow, 17).Value = Me.ComboBox1.Value
  .Cells(iRow, 6).FormulaLocal = "=CONCATENAR(LIMPIAR(ESPACIOS(B" & iRow & ")),SI(LIMPIAR(ESPACIOS(C" & iRow & "))="""","""","" ""),LIMPIAR(ESPACIOS(C" & iRow & ")),SI(LIMPIAR(ESPACIOS(D" & iRow & "))="""","""","" ""),LIMPIAR(ESPACIOS(D" & iRow & ")),SI(LIMPIAR(ESPACIOS(E" & iRow & "))="""","""","" ""),LIMPIAR(ESPACIOS(E" & iRow & ")))"
  .Cells(iRow, 9).FormulaLocal = "=SIFECHA(H" & iRow & ",HOY(),""Y"")"

End With

'clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.TextBox7.Value = ""
Me.TextBox8.Value = ""
Me.TextBox9.Value = ""
Me.TextBox10.Value = ""
Me.TextBox11.Value = ""
Me.TextBox12.Value = ""
Me.TextBox13.Value = ""
Me.ComboBox1.Value = ""
Me.TextBox1.SetFocus


End Sub

如何根据UserForm中的条件生成唯一ID

2 个答案: