2016-06-07 84 views
0

我有一个用于患者注册的USerForm,在所述UserForm中存在用于选择主要医生的组合框,我希望根据医生选择生成患者ID,我甚至不开始从哪里开始,我希望代码能够评估哪个是最后一个具有相同前缀的ID以生成下一个ID,例如如何根据UserForm中的条件生成唯一ID

KT000001 
KT000002 
LG000001 

下面是用户窗体代码

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 
+0

是你问如何增加给定的ID('KT000001' - >'KT000002')或如何增加创建一个全新的(“患者数据” - >'KT000001')? – arcadeprecinct

+0

我会在一个包含医生名单的单独工作表上做一个临时表格,并在第二个表格中填写“下一个患者ID”。在您将数据添加到数据库后,您将增加所选医生旁边的患者索引。你总是知道每位医生的下一个号码是什么。 – kamila

+0

@arcadeprecinct创建一个完全新的 –

回答

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 
+0

读取我注意到的代码'docID = Me.ComboBox1.Value'<〜从ComboBox1中检索医生ID值ComboBox1是Doctor的名字,所以我猜它应该是类似' docID = If Me.ComboBox1.Value =“Doctor name 1” Then“KP” Else“LP”'这是否合理?它是如何工作的? @ user3598756 –

+0

我假定组合框已经填充了医生ID。情况并非如此,组合框中应该填入医生真实姓名(“John Doe”,“Mark Smith”,...)以与相应的ID(“KP”,“LP”,...)关联,那么它可以通过查找轻松完成。当然,必须有一个地方(一个范围?)在哪里读取医生姓名和他们相应的ID从 – user3598756

+0

我做了一个小测试 'Select Case Me.ComboBox1.Value Case Is =“Agent 1” docID = “AGT1” 情况= “剂2” 的docID = “AGT2” 情况= “代理3” 的docID = “AGT3” 情况= “代理4” 的docID = “AGT4” 结束Select' 它后来工作,我将它合并到我的原始代码,看看它如何去 –

0

这是我最后的工作代码

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