根据userform VBA上的用户输入输入新数据

时间:2018-03-07 16:19:34

标签: excel vba excel-vba updates userform

我目前正在处理一个项目(Excel 2016中的用户表单),该项目旨在每月输入新的客户信息。我希望用户使用ID号搜索每个客户端。用户通过用户表单输入ID号后(ID nubmer也位于下一页标题为“更新”的A:A中)。然后代码循环通过A:A中下一个工作表上的数据来找到ID号。

我希望新客户信息更新与ID号输入相对应的行(例如,用户输入ID号12,12 =第2行中的Jon Doe,因此用户输入的任何新信息(在输入ID号12之后) )将被粘贴在第2行。)

enter image description here

enter image description here

'This sub locates the ID number corresponding to the name
'This section of code works well
Private Sub IDNumberBox_AfterUpdate()
'Checks to see if ID number exists
    If WorksheetFunction.CountIf(Sheet1.Range("A:A"), Me.IDNumberBox.Value) = 0 
    Then
MsgBox "ID Not Found" & vbNewLine & "Please enter different ID"
    End If
'Lookup names based on ID number
    With Me
.txtfirstname = Application.WorksheetFunction.VLookup(CLng(Me.IDNumberBox), 
Sheet1.Range("IDandNAMES"), 2, 0)
.textlastname = Application.WorksheetFunction.VLookup(CLng(Me.IDNumberBox), 
Sheet1.Range("IDandNAMES"), 3, 0)
   End With
   End Sub


'This is the input button
'This code does not input any new data
Private Sub inputbutton_Click()
Dim currentrow As Long
Dim ws As Worksheet
Set ws = Worksheets("Updates")
lrow = ws.Cells(Rows.Count, 4).End(xlToRight).Select
   With ws
   If WorksheetFunction.CountIf(Sheet1.Range("A:A"), Me.IDNumberBox.Value) = True Then
    .Cells(1row, 4).Value = Me.txtupdate.Value
   '^this line of code should input data from textbox("txtupdate") in column D and in the row corresponding with the ID number input by user
    .Cells(lrow, 5).Value = Me.cmbfinancial.Value
    .Cells(lrow, 6).Value = Me.txtwcfin.Value
    .Cells(lrow, 7).Value = Me.cmbeducation.Value
    .Cells(lrow, 8).Value = Me.txtwcedu.Value
    .Cells(lrow, 9).Value = Me.cmbemploy.Value

我是VBA的新手,非常感谢任何帮助。

2 个答案:

答案 0 :(得分:1)

如果您只是需要用户输入值,并且您想要使用该行,则可以使用:

Dim findRng As Range
Dim lookup As String
lookup = Trim(Application.InputBox("What ID do you want to find?"))
Set findRng = Range("A:A").Find(what:=lookup)
' Do whatever you need now.

If Not findRng Is Nothing Then
    Debug.Print "The row to use is: " & findRng.Row
Else
    MsgBox (lookup & " was not found in column A!")
End If

答案 1 :(得分:0)

我找到了搜索ID号的代码,显示了客户信息,并允许您编辑和/或输入与客户ID号对应的数据行的新信息。

Dim currentrow As Long

Private Sub CommandButton2_Click()
Dim lastrow
Dim myfname As String
Dim ws As Sheet11
lastrow = Sheet11.Range("A" & Rows.Count).End(xlUp).row
myfname = Me.Reg8.Value
For currentrow = 2 To lastrow
If ws.Cells(currentrow, 1).Text = myfname Then
ws.Cells(currentrow, 68).Value = Me.Reg10.Value
ws.Cells(currentrow, 69).Value = Me.Reg11.Value
ws.Cells(currentrow, 10).Value = Me.Reg5.Value
ws.Cells(currentrow, 9).Value = Me.Reg6.Value
ws.Cells(currentrow, 70).Value = Me.Reg7.Value
End If
Next
MsgBox "Information has" & vbNewLine & "been updated"
End Sub

 Private Sub Reg8_AfterUpdate()
'Checks to see if ID number exists
  If WorksheetFunction.CountIf(Sheet11.Range("A:A"), Me.Reg8.Value) = 0 Then
  MsgBox "ID Not Found" & vbNewLine & "Please enter new Mentee informantion and submit"
Exit Sub
End If
'Lookup values based on ID number
 With Me
.Reg1 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 2, 0)
.Reg2 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 3, 0)
.Reg3 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 5, 0)
.Reg4 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 7, 0)
 .Reg5 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 10, 0)
 .Reg6 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 9, 0)
 .Reg7 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 70, 0)
 .Reg9 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 45, 0)
 .Reg10 = Application.WorksheetFunction.VLookup(CLng(Me.Reg8), Sheet11.Range("IDRangeTest"), 68, 0)
 End With
 End Sub