Private Sub CommandButton5_Click()
' CARREGA DADOS DO LISTVIEW E FILTRA NA PLANILHA E ALTERA
On Error GoTo ERRO
' DESABILITA CALCULOS AUTOMATICOS
Application.Calculation = xlManual
' DESABILITA EVENTOS DA TELA
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Planilha1.Activate
Planilha1.Select
Dim resultado As VbMsgBoxResult
resultado = MsgBox("TEM CERTEZA QUE DESEJA REALIZAR ESSA VENDA?", vbYesNo, "F R CONTROLES")
If resultado = vbYes Then
Dim i As Integer, j As Integer
'conta qunatas linhas tem na minha listview
For i = 1 To ListView1.ListItems.Count
'valor procurado no listview
Dim codigo As Double
codigo = CDbl(ListView1.ListItems.ITEM(i))
ListView1.ListItems(i).Text = Empty
'fecha a busca no listview e limpa as linhas
'busca os dados na planilha e altera
Dim novalinha As Long
For novalinha = 2 To Worksheets("ESTOQUE").UsedRange.Rows.Count
'while Worksheets("ESTOQUE").Range("A" & novalinha).value <> ""
'With Worksheets("ESTOQUE").Range("A:A")
'Set c = .Find(codigo, LookIn:=xlValues, LookAt:=xlWhole)
'If Not c Is Nothing Then
If CDbl(Worksheets("ESTOQUE").Range("A" & novalinha).Value) = codigo Then
''c.Activate
'c.Select
Worksheets("ESTOQUE").Range("A" & novalinha).Select
Rows(Selection.Row).Interior.ColorIndex = 8
Selection.Columns(9) = ComboBox1.Value 'CLIENTE
Selection.Columns(11) = Format(TextBox3.Value, "mm/dd/yyyy") ' DATA
Selection.Columns(13) = ComboBox2.Value
'End If
'End With
End If
'novalinha = novalinha+1
'wend
Next novalinha
'fecha a busca na planilha e altera
For j = 1 To ListView1.ColumnHeaders.Count - 1
ListView1.ListItems(i).ListSubItems(j).Text = Empty
Next j
Next i
ListView1.ListItems.Clear
TextBox3 = ""
ComboBox1 = ""
ComboBox2 = ""
Label9 = ""
Label7 = ""
MsgBox "VENDA REALIZADA COM SUCESSO", vbInformation, "F R CONTROLES"
Else
MsgBox "CANCELADO COM SUCESSO", vbInformation, "F R CONTROLES"
Exit Sub
End If
' HABILITA A TELA
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
'HABILITA CACULOS
Application.Calculation = xlAutomatic
Exit Sub
ERRO:
MsgBox "ACONTECEU ALGUM AO REALIZAR A VENDA", vbInformation, "F R CONTROLES"
End Sub
tenho esse codigo ele funciona corretamente, porem demora muito para terminar o seu objetivo, alguem pode me ajudar a deixar ele mais rapido, ele serve para alterar toras as linhas q forem iguais a da minha pesquisa, porem ele demora muito quando for grande a quantidade de numeros iguais, alguem pode me ajudar?
Postado : 20/08/2018 7:49 am