Notifications
Clear all

codigo muito lento

17 Posts
4 Usuários
0 Reactions
3,712 Visualizações
(@fagneribas)
Posts: 67
Trusted Member
Topic starter
 

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
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não entendi o que considera "baixar pacotes"; como disse não assimilei a dinamica deseu projeto

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 21/08/2018 12:05 pm
(@fagneribas)
Posts: 67
Trusted Member
Topic starter
 

a dinamica e baixar varios pacotes, porem nao estava conseguindo fazer mais com um pouco de trabalho eu consegui resolver o meu problema,
por isso venho agradecer a atenção de todos q me ajudaram a resovolver esse problemas muito obg de coração msm... obg pessoal

 
Postado : 21/08/2018 12:19 pm
Página 2 / 2