Private Sub TextBox1_Change()
If TextBox1.Value = "" Then ListBox1.Clear: Exit Sub
Dim x As Worksheet
Dim Tot As Double
ListBox1.Clear
k = 0
For Each x In ThisWorkbook.Worksheets
ss = x.Cells(Rows.Count, 1).End(xlUp).Row
For Each C In x.Range("B2:B" & ss)
b = InStr(C, TextBox1)
If b > 0 Then
ListBox1.AddItem
ListBox1.List(k, 0) = x.Cells(C.Row, 1).Value
ListBox1.List(k, 1) = x.Cells(C.Row, 2).Value
ListBox1.List(k, 2) = x.Cells(C.Row, 3).Value
ListBox1.List(k, 3) = x.Cells(C.Row, 4).Value
ListBox1.List(k, 4) = x.Cells(C.Row, 5).Value
ListBox1.List(k, 5) = x.Cells(C.Row, 6).Value
ListBox1.List(k, 6) = x.Cells(C.Row, 7).Value
Tot = Tot + x.Cells(C.Row, 7).Value
k = k + 1
End If
Next C
Next x
Me.TextBox2 = Tot
End Sub
Dim UfDic As Object
Private Sub TextBox1_Change()
Dim Ky As Variant
Dim r As Long, c As Long
If TextBox1.Value = "" Then ListBox1.Clear: Exit Sub
ListBox1.Clear
For Each Ky In UfDic.keys
If InStr(1, Ky, Me.TextBox1.Value, 1) > 0 Then
With Me.ListBox1
.AddItem Ky
For c = 1 To 5
.List(r, c) = UfDic(Ky)(c)
Next c
r = r + 1
End With
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim Ws As Worksheet
Dim Cl As Range
Dim Tmp As Variant
Set UfDic = CreateObject("scripting.dictionary")
For Each Ws In Worksheets
For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
If Not UfDic.exists(Cl.Value) Then
UfDic.Add Cl.Value, Application.Index(Cl.Offset(, 1).Resize(, 5).Value, 1, 0)
Else
Tmp = UfDic(Cl.Value)
Tmp(3) = Tmp(3) + Cl.Offset(, 3).Value
Tmp(4) = Tmp(4) + Cl.Offset(, 4).Value
Tmp(5) = Tmp(5) + Cl.Offset(, 5).Value
UfDic(Cl.Value) = Tmp
End If
Next Cl
Next Ws
End Sub
Option Compare Text
Dim oDic As Object
Private Sub TextBox1_Change()
Dim V, W
If oDic.Count = 0 Then Beep: Exit Sub
ListBox1.Clear
If TextBox1.Value = "" Then TextBox2.Value = "": Exit Sub
With CreateObject("Scripting.Dictionary")
For Each V In oDic.Keys
If V Like TextBox1.Value & "*" Then .Item(V) = oDic(V): W = W + oDic(V)(1, 6)
Next
If .Count = 1 Then ListBox1.List = .Items()(0) Else If .Count > 1 Then ListBox1.List = Application.Index(.Items, 0)
.RemoveAll
End With
TextBox2.Value = W
End Sub
Private Sub UserForm_Initialize()
Dim Ws As Worksheet, Rg As Range, V, C%
Set oDic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
For Each Rg In Ws.Range("B2", Ws.Cells(Ws.Rows.Count, 2).End(xlUp))
If Rg.Value2 > "" Then
V = oDic(Rg.Value2)
If IsArray(V) Then
For C = 4 To 6: V(1, C) = V(1, C) + Rg(1, C).Value2: Next
Else
V = Rg.Resize(, 6).Value2
End If
oDic(Rg.Value2) = V
End If
Next
Next
End Sub