Question

我是StackOverflow和VBA编码的新手，并且由于我的C＆P /编辑技能，我得以根据自己公司的需要制作了业余CRM。

我想出了一个用户表单（您可以在其中找到其屏幕快照），该表单将数据存储在一个工作表（Maindata）中，还创建了另一个用户工作表（工作表名称是从中心ID文本框中获取的，因此动态），其中包含该中心的具体数据和财务预测。

让我为您简要介绍电子表格；

主数据：数据输入从A2开始到AU2（总共47列），电子表格尚未填充，但是到时它可能会超过+400行。

基本上我想实现的是用户表单中的搜索和更新功能。我无法将预先注册的数据带回我的用户表单。搜索也应带来部分匹配，因此搜索时可能有多个注册表。为了从搜索查询中选择合适的一个，我添加了一个列表框，该框应在内部为我提供搜索结果，双击该框应将整行的数据返回给用户表单。在更新时，它应在相关行上更新/覆盖（不应创建新的注册表），并且应更新指定的动态命名表（在注册表中使用“ Center ID”创建相同名称的表）细胞。

更具体地讲搜索和更新;

用户将输入“ textbox1”
点击搜索按钮，称为“ cbSearch”
匹配注册表将列在“ listbox1”中
在双击用户窗体时，将使用所选内容填充注册信息。（列表框将显示4个数据集，但之后 dclick，其余信息将显示在用户表单上）
“更新”按钮应覆盖“ maindata”上的现有信息工作表以及与其中心ID相匹配的工作表。

如果您可以向我展示如何使用列表框中所选项目的信息填充文本框，则可以将其适应46列的其余部分：）

“ A”列的信息应包含在= TB0中 “ B”列的信息应输入= STN

我将保存按钮的代码放到用户表单中，该按钮的代码为％90。

https://external-uri.com/api/greeting

谢谢！

Answer 1

如果ListBox中只有一列，则可以只使用Range("A1").Value2 = Me.ListBox1.Text（或.Value）。但是，如果ListBox有多列，则需要获取所选行的位置。不幸的是，VBA没有直接的方法，因此我们需要遍历列表中的项目。

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

这是在单击ListBox时运行的（您可能需要为您的代码进行更改）。查找已选择的项目并返回第2列中的值（行和列均从0开始）

搜索功能 例如搜索演示

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

我已使用演示搜索功能对其进行了更新。您需要使用数据范围更新UserForm_Initialize。您可以为此进行很多更改，也可以轻松对其进行扩展，但这是一个快速演示。我还使用了TextBox1_Change事件，而不是单击搜索按钮，但这又可以很容易地更改。该代码的搜索功能使用Levenshtein比率来尝试比较相似的字符串。同样，还有其他方法可以实现这一目标。

您还需要根据要搜索的内容进行配置。这将分别考虑数据集的每一列，并将返回所有匹配的列。

用户表单-搜索和更新功能

1 个答案: