Option Explicit
'Autor: Tomás Vásquez
' www.tomasvasquez.com.br
' www.tomasvasquez.com.br/blog
' www.tomasvasquez.com.br/forum
' www.tomasvasquez.com.br/cursocsharp
Private Const NomePlanilha As String = "Fornecedores"
Private Const LinhaCabecalho As Integer = 1
Private Sub TextBox1_Change()
If Me.cboCampo2.ListIndex <> -1 Then
Call PreencheLista(TextBoxFiltro.Text, TextBox1.Text)
End If
End Sub
Private Sub TextBoxFiltro_Change()
If Me.ComboBoxCampos.ListIndex <> -1 Then
Call PreencheLista(TextBoxFiltro.Text, TextBox1.Text)
End If
End Sub
Private Sub UserForm_Initialize()
Call PreencheCampos
End Sub
Private Sub PreencheCampos()
Dim ws As Worksheet
Dim coluna As Integer
Dim linha As Integer
Set ws = ThisWorkbook.Worksheets(NomePlanilha)
coluna = 1
linha = LinhaCabecalho
With ws
While .Cells(linha, coluna).Value <> Empty
Me.ComboBoxCampos.AddItem .Cells(linha, coluna)
Me.cboCampo2.AddItem .Cells(linha, coluna)
coluna = coluna + 1
Wend
End With
End Sub
Private Sub PreencheCabecalho(ByRef Lista())
Dim ws As Worksheet
Dim coluna As Integer
Dim linha As Integer
Set ws = ThisWorkbook.Worksheets(NomePlanilha)
coluna = 1
linha = LinhaCabecalho
With ws
While .Cells(linha, coluna).Value <> Empty
Lista(coluna - 1, 0) = .Cells(linha, coluna)
coluna = coluna + 1
Wend
End With
End Sub
Private Sub PreencheLista(ByVal TextoDigitado As String, ByVal TextoDigitado2 As String)
On Error GoTo fim
Dim ws As Worksheet
Dim i As Integer
Dim x As Integer
Dim indiceLista As Integer
Dim coluna, coluna2 As Integer
Dim TextoCelula As String
Dim TextoCelula2 As String
Set ws = ThisWorkbook.Worksheets(NomePlanilha)
Dim Lista()
ReDim Lista(ws.UsedRange.Columns.Count, 0)
i = LinhaCabecalho + 1
indiceLista = 1
coluna = Me.ComboBoxCampos.ListIndex + 1
coluna2 = Me.cboCampo2.ListIndex + 1
Call PreencheCabecalho(Lista)
ListBoxLista.Clear
With ws
While .Cells(i, coluna).Value <> Empty
TextoCelula = .Cells(i, coluna).Value
TextoCelula2 = .Cells(i, coluna2).Value
If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
If UCase(Left(TextoCelula2, Len(TextoDigitado2))) = UCase(TextoDigitado2) Then
For x = 0 To ws.UsedRange.Columns.Count - 1
ReDim Preserve Lista(ws.UsedRange.Columns.Count, indiceLista)
Lista(x, indiceLista) = .Cells(i, x + 1)
Next
indiceLista = indiceLista + 1
End If
End If
i = i + 1
Wend
End With
Lista = Array2DTranspose(Lista)
Me.ListBoxLista.List = Lista
fim:
End Sub
Function Array2DTranspose(avValues As Variant) As Variant
Dim lThisCol As Long, lThisRow As Long
Dim lUb2 As Long, lLb2 As Long
Dim lUb1 As Long, lLb1 As Long
Dim avTransposed As Variant
If IsArray(avValues) Then
On Error GoTo ErrFailed
lUb2 = UBound(avValues, 2)
lLb2 = LBound(avValues, 2)
lUb1 = UBound(avValues, 1)
lLb1 = LBound(avValues, 1)
ReDim avTransposed(lLb2 To lUb2, lLb1 To lUb1)
For lThisCol = lLb1 To lUb1
For lThisRow = lLb2 To lUb2
avTransposed(lThisRow, lThisCol) = avValues(lThisCol, lThisRow)
Next
Next
End If
Array2DTranspose = avTransposed
Exit Function
ErrFailed:
Debug.Print Err.Description
Debug.Assert False
Array2DTranspose = Empty
Exit Function
Resume
End Function
Anexo
Postado : 26/03/2018 1:38 pm