[Resolvido] Busca com duas textbox na mesma linha

2024 - VBA & Macros

Post Recente por Dunguinha 4 anos atrás

4 Posts

2 Usuários

1 Reactions

1,129 Visualizações

RSS

Dunguinha

(@dunguinha)

Posts: 61

Trusted Member

Topic starter

Bom dia.

A planilha tem por objetivo buscar o valor na coluna (R) digitado na "TextBox1" e o número da nota na coluna (D) digitado na "TextBox2".

O correto seria achar o valor mais o número da nota simultaneamente na mesma linha, ocorrendo a formatação da linha como esta no código, caso contrário não passar a verificação.

Mas o código não esta funcionando para TextBox2, qualquer número digitado ou se deixar em branco esta passando.

Confere-GNRE.xlsm

Postado : 08/11/2020 7:44 am

Dunguinha

(@dunguinha)

Posts: 61

Trusted Member

Topic starter

@anderson

Mano, me ajuda ae...

Já fiz isso e não funciona, tentei uma porrada de coisas.

Postado : 08/11/2020 10:57 am

Anderson

(@anderson)

Posts: 203

Reputable Member

Private Sub CommandButton1_Click()

Dim a As Long
Dim i As Long
Dim ulinhax As Long
Dim sprocurar As String
Dim eprocurado As Double
Dim counter As Long
Dim ulinha As Long
Dim UltimaLinha As Long

Application.ScreenUpdating = False

Labels

counter = 0
ulinhax = Plan1.Cells(Cells.rows.Count, 18).End(3).Row
sprocurar = VBA.Trim(Me.TextBox1.Text)

If VBA.Len(sprocurar) = 0 Then
MsgBox "NENHUM VALOR FOI DIGITADO! ", vbExclamation, "Atenção!"
TextBox1.Text = Empty
Me.TextBox1.SetFocus
Exit Sub
End If

eprocurado = VBA.CDbl(sprocurar)


sprocurar2 = VBA.Trim(Me.TextBox2.Text)

If VBA.Len(sprocurar2) = 0 Then
MsgBox "NENHUM VALOR FOI DIGITADO! ", vbExclamation, "Atenção!"
TextBox2.Text = Empty
Me.TextBox2.SetFocus
Exit Sub
End If

eprocurado2 = VBA.CDbl(sprocurar2)

UltimaLinha = Sheets("Plan1").Cells(Cells.rows.Count, 18).End(xlUp).Row

If UltimaLinha < Worksheets("Plan1").Range("AD1") Then UltimaLinha = Worksheets("Plan1").Range("AD1")

For i = Worksheets("Plan1").Range("AD1") To UltimaLinha

If Plan1.Cells(i, 18) = eprocurado And Plan1.Cells(i, 18).Font.Bold = True Then
MsgBox "VALOR DIGITADO REPETIDO! ", vbCritical, " ATENÇÃO!!!"
TextBox1 = ""
TextBox2 = ""
TextBox1.SetFocus
Exit Sub
End If


If Plan1.Cells(i, 4) = eprocurado2 And Plan1.Cells(i, 4).Font.Bold = True Then
MsgBox "VALOR DIGITADO REPETIDO! ", vbCritical, " ATENÇÃO!!!"
TextBox1 = ""
TextBox2 = ""
TextBox1.SetFocus
Exit Sub
End If

If Plan1.Cells(i, 18) = eprocurado And Plan1.Cells(i, 4) = eprocurado2 Then
Range("C" & i).Select

'Data
Range("C" & i).Font.Size = 11
Range("C" & i).Font.Bold = True

'Número Nota
'Range("D" & i).Font.Size = 11
'Range("D" & i).Font.Bold = True
'Range("D" & i).Font.Color = RGB(192, 0, 0)

'UF
Range("E" & i).Font.Size = 11
Range("E" & i).Font.Bold = True

'CFOP
Range("F" & i).Font.Size = 11
Range("F" & i).Font.Bold = True

'Valor ST
Range("R" & i).Font.Bold = True
Range("R" & i).Font.Color = RGB(0, 0, 0)
Range("R" & i).Font.Size = 11

'Linha Razão Social
Range("V" & i).Font.Size = 10
Range("V" & i).Font.Bold = True
Range("V" & i).Font.Color = RGB(192, 0, 0)

'Número da Linha
Range("AB" & i).Font.Size = 10
Range("AB" & i).Font.Color = RGB(166, 166, 166)

'ActiveCell.FormulaR1C1 = "=RC[-6]"

'Hora
Plan1.Cells(i, 29).Value = time
Plan1.Cells(i, 29).Font.ColorIndex = 25
Plan1.Cells(i, 29).Font.Size = 8

TextBox1 = ""
TextBox2 = ""
TextBox1.SetFocus

counter = counter + 1

'Módulo PassarTraços
Call ContornoCélulas

End If
Next i

' If counter = 0 Then
'
' MsgBox "VALOR DIGITADO NÃO ENCONTRADO! ", vbCritical, "ERRO"
' TextBox1 = ""
' TextBox2 = ""
' Label3 = ""
' TextBox1.SetFocus

''==============PROCURA NÚMERO DA NOTA===============
'
' ElseIf TextBox2.Text <> "" Then
'
' Dim UltLinhatx As Long
' Dim k As Long
'
' UltLinhatx = Sheets("Plan1").Cells(Cells.rows.Count, 4).End(xlUp).Row
'
' If UltLinhatx < Worksheets("Plan1").Range("AD1") Then UltLinhatx = Worksheets("Plan1").Range("AD1")
'
' For k = Worksheets("Plan1").Range("AD1") To UltLinhatx
'
' If CDbl(TextBox2.Text) = CDbl(Range("D" & k).Text) Then
' Range("D" & k).Font.Name = "Book Antiqua"
' Range("D" & k).Font.Size = 11
' Range("D" & k).Font.Bold = True
' Range("D" & i).Font.Color = RGB(221, 217, 196)
' Range("C" & i).Select
' TextBox1 = ""
' TextBox2 = ""
' Me.TextBox1.SetFocus
'
' Exit For
'
'Else
'
' If k = UltLinhatx Then
' MsgBox "NOTA FISCAL NÃO ENCONTRADA! ", vbCritical, "ERRO"
' TextBox2 = ""
' Me.TextBox2.SetFocus
'
' End If
' End If
' Next k
' End If
End Sub

Private Sub CommandButton2_Click()

'Call Formatar_Linha_MG

Range("D10000").End(xlUp).Offset(1, -1).Select
Unload UserForm1
'UserForm2.Show

End Sub

Private Sub TextBox1_Change()

'Comando para apagar "UF" quando digitar outro valor
If UserForm1.TextBox1 <> "" Then
Label3 = ""

Frame1.BackColor = &HC0FFFF
Label3.BackColor = &HC0FFFF

End If

'==========================================================================

'Código para colocar ponto e virgula automaticamente na TextBox1

Dim valor
Dim numPonto
Dim numVirgula

valor = TextBox1.Value

If IsNumeric(valor) Then
If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "")
If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", ""))
If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "")

Select Case Len(valor)
Case 1
numPonto = "00" & valor
Case 2
numPonto = "0" & valor
Case 6 To 8
numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
Case 9 To 11
numPonto = Pontuacao(8, valor)
Case 12 To 14
numPonto = Pontuacao(11, valor)
Case Else
numPonto = valor
End Select

numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
TextBox1.Value = numVirgula

Else

If Me.TextBox1.Text = "p" Then
Unload UserForm1
UserForm6.Show
UserForm6.TextBox101.SetFocus
UserForm6.TextBox101 = ""

Exit Sub
End If

If valor = "" Then Exit Sub
MsgBox " Não digite vírgula ou letras!", vbCritical, "Atenção..."

TextBox1.Text = ""

Exit Sub
End If

End Sub

Private Sub CommandButton3_Click()

Unload UserForm1
UserForm6.Show

End Sub

Public Sub Labels()

Dim x As Range
Dim sLin
Dim UL
Dim PL, c

sLin = 10

If Me.TextBox1 = "" Then

Exit Sub
End If

UL = Plan1.Range("R65536").End(xlUp).Row '.Value 'definir a UL(UltimaLinha)
PL = Plan1.Range("R10").End(xlUp).Row '.Value 'definir a PL(Primeira Linha)

Set x = Plan1.Range("R" & UL & ":" & "R" & 10)

For Each c In x

If CStr(c.Value) = CStr(TextBox1) Then
Me.Label3 = Plan1.Range("E" & sLin).Value

Frame1.BackColor = &HFFFFFF
Label3.BackColor = &HFFFFFF

End If

sLin = sLin + 1

Next

If Label3 = "MG" Then

MsgBox " Para o Estado de MG não paga GNRE!", vbCritical, "Atenção..."
TextBox1 = ""
TextBox2 = ""
TextBox1.SetFocus
End If

End Sub


Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

'Limita a Qde de caracteres
TextBox2.MaxLength = 6

End Sub

Function Pontuacao(inicio, valor)

'Função da pontuação na TextBox1
i = Left(valor, Len(valor) - inicio)
M1 = Left(Right(valor, inicio), 3)
M2 = Left(Right(valor, 8), 3)
f = Right(valor, 5)

If (M2 = M1) And (Len(valor) < 12) Then
Pontuacao = i & "." & M1 & "." & f

Else

Pontuacao = i & "." & M1 & "." & M2 & "." & f

End If

End Function