繁体   English   中英

根据用户表单 VBA 上的用户输入输入新数据

[英]Input new data based off user input on userform VBA

我目前正在开展一个项目(Excel 2016 中的用户表单),该项目旨在每个月输入新的客户信息。 我希望用户使用 ID 号搜索每个客户。 在用户通过用户表单输入 ID 号后(ID 号也位于下一个标题为“更新”的工作表的 A:A 中)。 然后代码循环遍历 A:A 中下一张纸上的数据以定位 ID 号。

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

在此处输入图片说明

在此处输入图片说明

'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 的新手,任何帮助将不胜感激。

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

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

我找到了搜索 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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM