Excel 用户表单-搜索和；更新能力

我是StackOverflow和VBA编码的新手，多亏了我的C&p/编辑技能，我成功地为我自己在公司的需要制作了一个业余CRM

我提出了一个用户表单（你可以找到它的屏幕截图附件），它将数据存储在一个工作表（Maindata）中，并创建一个新的另一个工作表（工作表名称是从中心ID文本框中获取的，所以是动态的），其中包含该中心的特定数据和财务预测

让我简要介绍一下电子表格

主数据：数据输入从A2开始，进入AU2（共47列）。电子表格尚未填充，但填充时可能会有+400行长

基本上我想要达到的是；用户表单中的搜索和更新功能。我无法将预先注册的数据带回我的用户表单。搜索也应该带来部分匹配，因此搜索时可能有多个注册表。为了从search inquiry中选择正确的一个，我添加了一个列表框，该列表框应该会给出里面的搜索结果，当双击时，它应该会将整行的数据带回用户表单。在更新时，它应更新/覆盖相关行（不应创建新注册表），并应更新动态命名工作表（使用与注册表中“中心ID”相同的名称创建）的指定单元格

更具体的搜索和更新

用户将在“textbox1”中键入

点击名为“cbSearch”的搜索按钮

匹配的注册表将列在“列表框1”中

双击后，用户表单将填充所选的 注册表信息。（列表框将显示4个克隆的数据，但在 dclick，其余信息将显示在userform上）

更新按钮应覆盖“maindata”上的现有信息 图纸和与其中心ID匹配的图纸

如果您能告诉我如何用listbox中所选项目的信息填充文本框，我可以将其调整为46列中的其余部分：）

“A”列的信息应进入=TB0 “B”列的信息应进入=STN

我将保存按钮的代码放在userform中，其中包含代码的90%

Private Sub CommandButton1_Click()

If TB0.Value = "" Or STN.Value = "" Or cbCountry.Value = "" Or tbCity.Value = "" Then

If TB0.Value = "" Then
TB0.BackColor = vbRed
End If

If STN.Value = "" Then
STN.BackColor = vbRed
End If

If cbCountry.Value = "" Then
cbCountry.BackColor = vbRed
End If

If tbCity.Value = "" Then
tbCity.BackColor = vbRed
End If

    MsgBox "Please Fill The Required Fields", vbCritical
    Exit Sub

End If

If CP1.Value = "" And CP2.Value = "" And CP3.Value = "" Then

If CP1.Value = "" Then
CP1.BackColor = vbRed
End If

If CP2.Value = "" Then
CP2.BackColor = vbRed
End If

If CP3.Value = "" Then
CP3.BackColor = vbRed
End If

    MsgBox "Center Price Is Required", vbCritical
    Exit Sub

End If



'Make Daily_Tracking_Dataset active
Worksheets("MainData").Activate

'Determine emptyRow
Emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer Information
Cells(Emptyrow, 1).Value = TB0.Value
Cells(Emptyrow, 2).Value = STN.Value
Cells(Emptyrow, 3).Value = cbCountry.Value
Cells(Emptyrow, 4).Value = tbCity.Text
Cells(Emptyrow, 5).Value = cbLab.Value
Cells(Emptyrow, 6).Value = tba.Value
Cells(Emptyrow, 7).Value = tbb.Value
Cells(Emptyrow, 8).Value = tbc.Value
Cells(Emptyrow, 9).Value = tbd.Value
Cells(Emptyrow, 10).Value = ctb1.Value
Cells(Emptyrow, 11).Value = ctb2.Value
Cells(Emptyrow, 12).Value = ctb3.Value
Cells(Emptyrow, 13).Value = ctb4.Value
Cells(Emptyrow, 14).Value = ctb5.Value
Cells(Emptyrow, 15).Value = ctb6.Value
Cells(Emptyrow, 16).Value = ctb7.Value
Cells(Emptyrow, 17).Value = ctb8.Value
Cells(Emptyrow, 18).Value = ctb9.Value
Cells(Emptyrow, 19).Value = ctb10.Value
Cells(Emptyrow, 20).Value = ctb11.Value
Cells(Emptyrow, 21).Value = ctb12.Value
Cells(Emptyrow, 22).Value = ctb13.Value
Cells(Emptyrow, 23).Value = ctb14.Value
Cells(Emptyrow, 24).Value = ctb15.Value
Cells(Emptyrow, 26).Value = tb11.Value
Cells(Emptyrow, 27).Value = CP1.Value
Cells(Emptyrow, 28).Value = CP2.Value
Cells(Emptyrow, 29).Value = CP3.Value
Cells(Emptyrow, 30).Value = CP4.Value
Cells(Emptyrow, 31).Value = Pricingbox1.Value
Cells(Emptyrow, 32).Value = Pricingbox2.Value
Cells(Emptyrow, 33).Value = Pricingbox3.Value
Cells(Emptyrow, 34).Value = Pricingbox4.Value
Cells(Emptyrow, 35).Value = Pricingbox5.Value
Cells(Emptyrow, 36).Value = Pricingbox6.Value
Cells(Emptyrow, 37).Value = Pricingbox7.Value
Cells(Emptyrow, 38).Value = Pricingbox8.Value
Cells(Emptyrow, 39).Value = Pricingbox9.Value
Cells(Emptyrow, 40).Value = Pricingbox10.Value
Cells(Emptyrow, 41).Value = Pricingbox11.Value
Cells(Emptyrow, 42).Value = Costtb1.Value
Cells(Emptyrow, 43).Value = Costtb2.Value
Cells(Emptyrow, 44).Value = Costtb3.Value
Cells(Emptyrow, 45).Value = Costtb4.Value
Cells(Emptyrow, 46).Value = Costtb5.Value
Cells(Emptyrow, 47).Value = VAT.Value


  myvar = ""

  For x = 0 To Me.lb.ListCount - 1
  If Me.lb.Selected(x) Then
  If myvar = "" Then
  myvar = Me.lb.List(x, 0)
    Else

    myvar = myvar & "," & Me.lb.List(x, 0)
    End If
  End If
 Next x

Cells(Emptyrow, 25).Value = myvar



Dim Newsheet, SheetName2 As String
Newsheet = STN.Text
SheetName2 = ActiveSheet.Name

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Newsheet

Sheets("template").Visible = True
Sheets("Template").Select
Cells.Select
Selection.Copy
Sheets(Newsheet).Select
ActiveSheet.Paste


Range("A10").Value = STN.Value
Range("B10").Value = cbCountry.Value
Range("C10").Value = CP1.Value
Range("D10").Value = CP2.Value
Range("E10").Value = CP3.Value
Range("F10").Value = CP4.Value
Range("G10").Value = Pricingbox1.Value
Range("I10").Value = Pricingbox2.Text
Range("K10").Value = Pricingbox3.Value
Range("M10").Value = Pricingbox4.Value
Range("O10").Value = Pricingbox5.Value
Range("Q10").Value = Pricingbox6.Value
Range("S10").Value = Pricingbox7.Value
Range("U10").Value = Pricingbox8.Value
Range("w10").Value = Pricingbox9.Value
Range("y10").Value = Pricingbox10.Value
Range("aa10").Value = Pricingbox11.Value
Range("a12").Value = Costtb1.Value
Range("b12").Value = Costtb2.Value
Range("c12").Value = Costtb3.Value
Range("d12").Value = Costtb4.Value
Range("e12").Value = Costtb5.Value
Range("F12").Value = VAT.Value
Range("g12").Value = cbLab.Value
Range("h12").Value = tba.Value
Range("ı12").Value = tbb.Value
Range("j12").Value = tbc.Value
Range("k12").Value = tbd.Value
Range("b2").Value = ctb1.Value
Range("d2").Value = ctb2.Value
Range("f2").Value = ctb3.Value
Range("b3").Value = ctb4.Value
Range("d3").Value = ctb5.Value
Range("f3").Value = ctb6.Value
Range("b4").Value = ctb7.Value
Range("d4").Value = ctb8.Value
Range("f4").Value = ctb9.Value
Range("b5").Value = ctb10.Value
Range("d5").Value = ctb11.Value
Range("f5").Value = ctb12.Value
Range("b6").Value = ctb13.Value
Range("d6").Value = ctb14.Value
Range("f6").Value = ctb15.Value





Sheets("template").Visible = False



Dim cell As Range, ws As Worksheet
    With Sheets("MainData")   'Sheet with the hyperlink sheet names
        On Error Resume Next
        For Each cell In .Range("B1", .Range("B" & Rows.Count).End(xlUp))   'Loop for each used cell in column A
            If cell.Value <> "" Then
                Set ws = Nothing
                Set ws = Sheets(cell.Value)
                If Not ws Is Nothing Then
                    .Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:=("'" & cell.Value & "'!B1")
                End If
            End If
        Next cell
        On Error GoTo 0
    End With




End Sub

Private子命令按钮1\u单击（）
如果TB0.Value=“”或STN.Value=“”或cbCountry.Value=“”或tbCity.Value=“”，则
如果TB0.Value=”“，则
TB0.BackColor=vbRed
如果结束
如果STN.Value=”“，则
STN.BackColor=vbRed
如果结束
如果cbCountry.Value=”“，则
cbCountry.BackColor=vbRed
如果结束
如果tbCity.Value=”“，则
tbCity.BackColor=vbRed
如果结束
MsgBox“请填写所需字段”，vbCritical
出口接头
如果结束
如果CP1.Value=“”和CP2.Value=“”和CP3.Value=“”，则
如果CP1.Value=”“，则
CP1.BackColor=vbRed
如果结束
如果CP2.Value=”“，则
CP2.BackColor=vbRed
如果结束
如果CP3.Value=”“，则
CP3.BackColor=vbRed
如果结束
MsgBox“需要中心价格”，vbCritical
出口接头
如果结束
'使每日跟踪数据集处于活动状态
工作表（“主数据”）。激活
“确定空罗
Emptyrow=工作表函数.CountA（范围（“A:A”））+1
“传输信息
单元格（Emptyrow，1）。值=TB0。值
单元格（清空，2）。值=标准值
单元格（Emptyrow，3）.Value=cbCountry.Value
单元格（Emptyrow，4）.Value=tbCity.Text
单元格（Emptyrow，5）.Value=cbLab.Value
单元格（Emptyrow，6）。值=tba。值
单元格（Emptyrow，7）。值=待定值
单元格（清空，8）。值=待定值
单元格（清空，9）。值=待定。值
单元格（清空，10）。值=ctb1。值
单元格（Emptyrow，11）。值=ctb2。值
单元格（Emptyrow，12）。值=ctb3。值
单元格（Emptyrow，13）。值=ctb4。值
单元格（Emptyrow，14）。值=ctb5。值
单元格（Emptyrow，15）。值=ctb6。值
单元格（Emptyrow，16）。值=ctb7。值
单元格（Emptyrow，17）。值=ctb8。值
单元格（Emptyrow，18）。值=ctb9。值
单元格（Emptyrow，19）。值=ctb10。值
单元格（清空，20）。值=ctb11。值
单元格（Emptyrow，21）。值=ctb12。值
单元格（Emptyrow，22）。值=ctb13。值
单元格（Emptyrow，23）。值=ctb14。值
单元格（Emptyrow，24）。值=ctb15。值
单元格（Emptyrow，26）。值=tb11。值
单元格（Emptyrow，27）。值=CP1。值
单元格（Emptyrow，28）。值=CP2。值
单元格（Emptyrow，29）。值=CP3。值
单元格（Emptyrow，30）。值=CP4。值
单元格（Emptyrow，31）.Value=Pricingbox1.Value
单元格（Emptyrow，32）.Value=Pricingbox2.Value
单元格（Emptyrow，33）.Value=Pricingbox3.Value
单元格（Emptyrow，34）.Value=Pricingbox4.Value
单元格（Emptyrow，35）.Value=Pricingbox5.Value
单元格（Emptyrow，36）.Value=Pricingbox6.Value
单元格（Emptyrow，37）.Value=Pricingbox7.Value
单元格（Emptyrow，38）.Value=Pricingbox8.Value
单元格（Emptyrow，39）.Value=Pricingbox9.Value
单元格（Emptyrow，40）.Value=Pricingbox10.Value
单元格（Emptyrow，41）.Value=Pricingbox11.Value
单元格（Emptyrow，42）。值=成本TB1。值
单元格（Emptyrow，43）。值=成本TB2。值
单元格（Emptyrow，44）。值=成本tB3。值
单元格（Emptyrow，45）。值=成本TB4。值
单元格（Emptyrow，46）。值=成本tB5。值
单元格（Emptyrow，47）。值=增值税。值
myvar=“”
对于x=0到Me.lb.ListCount-1
如果选择Me.lb.（x），则
如果myvar=”“，则
myvar=Me.lb.List（x，0）
其他的
myvar=myvar&“，”和Me.lb.List（x，0）
如果结束
如果结束
下一个x
单元格（Emptyrow，25）。值=myvar
Dim新闻纸，SheetName2作为字符串
新闻纸=标准文本
SheetName2=ActiveSheet.Name
Sheets.Add After:=工作表（Sheets.Count）
ActiveSheet.Name=新闻纸
图纸（“模板”）。可见=真实
图纸（“模板”）。选择
单元格。选择
选择，复制
工作表（新闻表）。选择
活动表。粘贴
范围（“A10”）。值=标准值
范围（“B10”）.值=cbCountry.值
范围（“C10”）。值=CP1。值
范围（“D10”）。值=CP2。值
范围（“E10”）。值=CP3。值
范围（“F10”）。值=CP4。值
范围（“G10”）。值=Pricingbox1。值
范围（“I10”）.Value=Pricingbox2.Text
范围（“K10”）.Value=Pricingbox3.Value
范围（“M10”）.Value=Pricingbox4.Value
范围（“O10”）.Value=Pricingbox5.Value
范围（“Q10”）.值=Pricingbox6.值
范围（“S10
Private Sub ListBox1_Click()
    Dim i As Long
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Me.TextBox1.Value = .List(i, 1)
                Exit For
            End If
        Next i
    End With
End Sub

Option Explicit
Dim Data As Variant
Private Sub UserForm_Initialize()
    Me.cboxCountry.List = Array("USA", "UK", "FR", "DE")
    Me.cboxLabCount.List = Array(1, 2, 3, 4, 5)

    ' Update with your data
    With Sheet1
        Data = .Range("A1:D4")
    End With

    Me.ListBox1.List = Data
End Sub
Private Sub TextBox1_Change()
    Me.ListBox1.List = FilteredResults(Me.TextBox1.Value)
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i As Long
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then Exit For
        Next i

        Me.tbCenterID.Value = .List(i, 0)
        Me.tbCenterName.Value = .List(i, 1)
        Me.cboxCountry.Value = .List(i, 2)
        Me.cboxLabCount.Value = .List(i, 3)
    End With
End Sub
Private Function FilteredResults(SearchValue As String) As Variant
    Dim tmp As Variant
    Dim i As Long
    Dim ResultCounter As Long
    ReDim tmp(LBound(Data, 2) To UBound(Data, 2), LBound(Data, 1) To UBound(Data, 1))

    If SearchValue = vbNullString Then
        FilteredResults = Data
    Else
        For i = LBound(Data, 1) To UBound(Data, 1)
            If Levenshtein(CStr(Data(i, 1)), SearchValue) Or _
               Levenshtein(CStr(Data(i, 2)), SearchValue) Or _
               Levenshtein(CStr(Data(i, 3)), SearchValue) Or _
               Levenshtein(CStr(Data(i, 4)), SearchValue) _
            Then
                ResultCounter = ResultCounter + 1
                tmp(1, ResultCounter) = Data(i, 1)
                tmp(2, ResultCounter) = Data(i, 2)
                tmp(3, ResultCounter) = Data(i, 3)
                tmp(4, ResultCounter) = Data(i, 4)
            End If
        Next i
        If ResultCounter > 0 Then
            ReDim Preserve tmp(LBound(tmp, 1) To UBound(tmp, 1), LBound(tmp, 2) To ResultCounter)
        End If
        FilteredResults = Transpose2DArray(tmp)
    End If
End Function
Private Function Transpose2DArray(tmpArray As Variant) As Variant
    Dim tmp As Variant
    Dim i As Long, j As Long
    ReDim tmp(LBound(tmpArray, 2) To UBound(tmpArray, 2), LBound(tmpArray, 1) To UBound(tmpArray, 1))

    For i = LBound(tmpArray, 1) To UBound(tmpArray, 1)
        For j = LBound(tmpArray, 2) To UBound(tmpArray, 2)
            tmp(j, i) = tmpArray(i, j)
        Next j
    Next i
    Transpose2DArray = tmp
End Function
Private Function Levenshtein(s1 As String, s2 As String) As Double
    Dim i As Integer
    Dim j As Integer
    Dim l1 As Integer
    Dim l2 As Integer
    Dim d() As Integer
    Dim min1 As Integer
    Dim min2 As Integer

    l1 = Len(s1)
    l2 = Len(s2)
    ReDim d(l1, l2)
    For i = 0 To l1
        d(i, 0) = i
    Next
    For j = 0 To l2
        d(0, j) = j
    Next
    For i = 1 To l1
        For j = 1 To l2
            If Mid(s1, i, 1) = Mid(s2, j, 1) Then
                d(i, j) = d(i - 1, j - 1)
            Else
                min1 = d(i - 1, j) + 1
                min2 = d(i, j - 1) + 1
                If min2 < min1 Then
                    min1 = min2
                End If
                min2 = d(i - 1, j - 1) + 1
                If min2 < min1 Then
                    min1 = min2
                End If
                d(i, j) = min1
            End If
        Next
    Next
    Levenshtein = 1 - (d(l1, l2) / Len(s2))
End Function