使用用户表单更新Excel工作表数据

Question

I am trying to enter in information in a database that I have in excel using a userform. The catch here is that I need to be able to enter data into a specific cell using a text box. For example, I open the userform and in textbox1 I type 123 in textbox2 I type 321. When I hit the submit button in the userform the code should look for the text "123" in a specific column. If the text "123" exists in the column specified in the code then it should take the data entered in textbox2(321) and put it in a cell adjacent to the cell containing the text 123

I have combed the internet looking for a solution to this and only found one that only sort of worked.

This is the link to that solution: https://youtu.be/cKKgYPfq3_I

The code wouldn't work consistently though. I don't know if this is because some of the edits I made to the code in this video caused the errors or if the code itself had any errors.

This will be for a database that will have a ton of information on it. Having a function like this would make it a lot easier for someone to update information on the database. You could have for example a list of phone numbers and names. With this function it would allow you to enter a name in one text box and a new phone number in the second text box. You could then update an individuals phone number when pushing the submit button.

Any suggestions would be a huge help.

Thanks in advance!

Below is what I have so far that I found from a different forum and edited from some help that I got from here. It doesn't seem to work. Then again it could be because the code wasn't at all intended for what I would like it to do. (My knowledge of VBA is limited to puzzle piecing code together that I can find that seems to work.)

    Option Explicit

Private Sub CommandButton1_Click()

Dim WS As Worksheet
Dim lastrow As Long
Dim r As Long
Dim datee As Integer
Dim m As Integer

Application.ScreenUpdating = False



m = 1


If IsNumeric(TextBox2.Text) Then



On Error GoTo ErrorHandler

datee = TextBox2.Text


Set WS = ActiveWorkbook.Worksheets("Scrap")
lastrow = WS.Cells(Rows.Count, "A").End(xlUp).Row


For r = 1 To lastrow


If WS.Cells(r, 2) = TextBox1.Text Then

    WS.Cells(r, 5).Value = TextBox2.Text
    WS.Cells(r, 8).Value = TextBox3.Text
    WS.Cells(r, 9).Value = TextBox4.Text
    WS.Cells(r, 10).Value = TextBox5.Text
    WS.Cells(r, 11).Value = TextBox6.Text
    WS.Cells(r, 12).Value = TextBox7.Text
    WS.Cells(r, 13).Value = TextBox8.Text
    WS.Cells(r, 14).Value = TextBox9.Text
    WS.Cells(r, 15).Value = TextBox10.Text
    WS.Cells(r, 16).Value = TextBox11.Text
    WS.Cells(r, 17).Value = TextBox12.Text
    WS.Cells(r, 18).Value = TextBox13.Text
    WS.Cells(r, 19).Value = TextBox14.Text


    Else

    WS.Cells(r, 2).Font.Color = vbRed

     m = 0


End If

Next
If m = 0 Then

MsgBox "Sales Order number not found,make sure the Sales Order Number you entered is correct", vbCritical

Else

MsgBox "Success", vbInformation

End If

TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

TextBox4.Text = ""

TextBox5.Text = ""

TextBox6.Text = ""

TextBox7.Text = ""

TextBox8.Text = ""

TextBox9.Text = ""

TextBox10.Text = ""

TextBox11.Text = ""

TextBox12.Text = ""

TextBox13.Text = ""

TextBox14.Text = ""

Unload Me


Application.ScreenUpdating = True

Exit Sub

ErrorHandler: MsgBox "Sorry an Error occured. " & vbCrLf & Err.Description

End If

MsgBox "Please Insert Data", vbCritical

End Sub

Answer 1

Please try this (we suppose that our sheet is the sheet2) :

Option Explicit

Private Sub CommandButton1_Click()

Dim WS As Worksheet
Dim lastrow As Long
Dim r As Long
Dim datee As Date


Application.ScreenUpdating = False





If IsDate(TextBox2.Text) Then



On Error GoTo ErrorHandler

datee = TextBox2.Text


Set WS = ActiveWorkbook.Worksheets("sheet2")
lastrow = WS.Cells(Rows.Count, "A").End(xlUp).Row


For r = 2 To lastrow


If WS.Cells(r, 3) = TextBox1.Text And WS.Cells(r, 2) = datee Then

    WS.Cells(r, 4).Value = TextBox2.Text
    WS.Cells(r, 5).Value = TextBox3.Text
    WS.Cells(r, 2).Font.Color = vbRed
    WS.Cells(r, 3).Font.Color = vbRed
    WS.Cells(r, 4).Font.Color = vbRed
    WS.Cells(r, 5).Font.Color = vbRed

    MsgBox "Success", vbInformation


TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

Unload Me


Application.ScreenUpdating = True

Exit Sub

End If

Next



MsgBox "Data not Found!!", vbCritical




TextBox1.Text = ""

TextBox2.Text = ""

TextBox3.Text = ""

Unload Me


Application.ScreenUpdating = True

Exit Sub

ErrorHandler: MsgBox "Sorry an Error occured. " & vbCrLf & Err.Description

Exit Sub

End If

MsgBox "Please Insert Date in the Date Box", vbCritical

Application.ScreenUpdating = True

End Sub