Question

Я новичок в кодировании StackOverflow и VBA, и благодаря моим навыкам C & P / редактирования мне удалось создать любительскую CRM для своих нужд в моей компании.

Скриншот пользовательской формы

Я создал пользовательскую форму (вы можете прикрепить скриншот к ней), которая хранит данные на одном листе (Maindata), а такжесоздает новый другой (имя листа получает свое имя из текстового поля идентификатора центра, то есть его динамику), который содержит конкретные данные этого центра и финансовые прогнозы.

Позвольте мне дать вам краткий обзор электронной таблицы;

Maindata: ввод данных начинается с A2 и продолжается до AU2 (всего 47 столбцов), что электронная таблица еще не заполнена, но когда это произойдет, вероятно, будет +400 строк.

В основномто, чего я хочу достичь, это;Возможность поиска и обновления в пользовательской форме.Я не могу вернуть предварительно зарегистрированные данные в свою форму пользователя.Поиск также должен привести к частичным совпадениям, поэтому при поиске может быть несколько реестров.Чтобы выбрать правильный из поискового запроса, я добавил список, в котором должны отображаться результаты поиска, а при двойном щелчке он возвращает данные всей строки обратно в форму пользователя.В момент обновления он должен обновить / перезаписать соответствующую строку (не следует создавать новый реестр) и обновить динамические именованные листы (которые создаются с тем же именем с «идентификатором центра» в указанном реестре)ячейки.

Чтобы быть более точным с поиском и обновлением;

Пользователь будет вводить в "textbox1"
Нажать кнопку поиска, которая называется "cbSearch"
Соответствующие реестры будут перечислены в «listbox1»
При двойном щелчке пользовательская форма будет заполнена выбранной регистрационной информацией. (Listbox покажет 4 скопления данных, но после dclick остальная информациябудет отображаться в пользовательской форме)
Кнопка «Обновить» должна перезаписывать существующую информацию на листе «maindata» и листе, который совпадает с его ID центра.

Если вы можете показать мне, как заполнить текстовое поле информацией о выбранном элементе из списка, я могу адаптировать его к остальным 46 столбцам :)

Информация столбца "A"должен войти в = TB0 "B" информация столбца должна войти в = STN

Я помещаю код кнопки сохранения, который имеет% 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

Заранее спасибо!

Tom · Answer 1 · 18 марта 2019

Если у вас есть только один столбец в 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 вместо нажатия кнопки поиска, но опять же, это можно легко изменить. Код использует коэффициент Левенштейна для своей функции поиска, чтобы попытаться сравнить похожие строки. Опять же, есть и другие способы достижения этого.

Вам также нужно будет настроить его в зависимости от того, что вы хотите искать. Это учитывает каждый столбец вашего набора данных по отдельности и возвращает все соответствующие.

Userform - возможность поиска и обновления

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Userform - возможность поиска и обновления

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы