Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Resumir a Macro
 
Notifications
Clear all

Resumir a Macro

 
Página 2 / 2
2024 - VBA & Macros
Post Recente por fazerbem 8 anos atrás
19 Posts
2 Usuários
0 Reactions
2,101 Visualizações
RSS
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Bom dia

Tento sempre fazer do meu jeito, antes de jogar a toalha,

A amcro abaixo, esta Ok e funcionando perfeitamente, porem como podem reparar ficou muito grande e talvez haja uma maneira mais Light de fazer o mesmo, pois quanto maior a macro mais tempo levará para executar a funcao correto ?

Entao teria como um amigo aqui abreviar os Comandos a partir de :

'---------------------------------------
'Aqui faz uma verificacao se existem outros produtos

Grato

Andre

 Sub MAIS_VENDIDOS_MENOS_VENDIDOS()
 
 '  Pocisionar Produto no Ranking
 
Dim Venda As String
Venda = Range("B1").Value

Dim WC, WR As Worksheet

Dim Cont As Long
Dim Produto As String
Application.ScreenUpdating = False

Dim WT     As Worksheet

Set WC = Worksheets("Ranking")
Set WR = Worksheets(Venda)

Produto = WR.Range("F72").Value
       
GoTo Voltar
Voltar:

Sheets("Ranking").Visible = True
    WC.Activate
    WC.Range("B2").Activate
    
    Do While ActiveCell <> ""
    
If ActiveCell = Produto Then
    
    ActiveCell.Offset(0, 1).Activate
    Cont = ActiveCell
    Cont = Cont + 1
    ActiveCell = Cont
Else
    ActiveCell.Offset(1, 0).Activate
    
End If
      
Loop
    WR.Activate
 
  
'---------------------------------------
'Aqui faz uma verificacao se existem outros produtos

If Range("F73").Value <> "" And Range("I73").Value = 0 Then
Produto = WR.Range("F73").Value
Range("I73").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F74").Value <> "" And Range("I74").Value = 0 Then
Produto = WR.Range("F74").Value
Range("I74").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F75").Value <> "" And Range("I75").Value = 0 Then
Produto = WR.Range("F75").Value
Range("I75").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F76").Value <> "" And Range("I76").Value = 0 Then
Produto = WR.Range("F76").Value
Range("I76").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F77").Value <> "" And Range("I77").Value = 0 Then
Produto = WR.Range("F77").Value
Range("I77").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F78").Value <> "" And Range("I78").Value = 0 Then
Produto = WR.Range("F78").Value
Range("I78").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F79").Value <> "" And Range("I79").Value = 0 Then
Produto = WR.Range("F79").Value
Range("I79").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F80").Value <> "" And Range("I80").Value = 0 Then
Produto = WR.Range("F80").Value
Range("I80").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F81").Value <> "" And Range("I81").Value = 0 Then
Produto = WR.Range("F81").Value
Range("I81").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F82").Value <> "" And Range("I82").Value = 0 Then
Produto = WR.Range("F82").Value
Range("I82").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F83").Value <> "" And Range("I83").Value = 0 Then
Produto = WR.Range("F83").Value
Range("I83").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F84").Value <> "" And Range("I84").Value = 0 Then
Produto = WR.Range("F84").Value
Range("I84").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F85").Value <> "" And Range("I85").Value = 0 Then
Produto = WR.Range("F85").Value
Range("I85").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If

If Range("F86").Value <> "" And Range("I86").Value = 0 Then
Produto = WR.Range("F86").Value
Range("I86").Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
Else
End If


 End Sub
 
Postado : 09/09/2016 8:05 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Conforme abaixo, funcionou sem problemas

Sub MAIS_VENDIDOS_MENOS_VENDIDOS()
'  Pocisionar Produto no Ranking

Dim Produto As String, Venda As String
Dim Cont As Long, x As Integer
Dim WC As Worksheet, WR As Worksheet, WT  As Worksheet

Application.ScreenUpdating = False
Venda = Range("B1").Value

Set WC = Worksheets("Ranking")
Set WR = Worksheets(Venda)

Produto = WR.Range("F71").Value

Voltar:
WC.Activate
WC.Range("B2").Activate
    
Do While ActiveCell <> ""
    If ActiveCell = Produto Then
        ActiveCell.Offset(0, 1).Activate
    Cont = ActiveCell
    Cont = Cont + WR.Range("G" & x).Value '+ 1
    ActiveCell = Cont
Else
    ActiveCell.Offset(1, 0).Activate
End If
Loop
'---------------------------------------
    WR.Activate
'Aqui faz uma verificacao se existem outros produtos

For x = 72 To 86
If Range("F" & x).Value <> "" And Range("I" & x).Value = 0 Then
Produto = WR.Range("F" & x).Value
Range("I" & x).Value = 1 'Aqui escrevo 1 para marcar que essa rotina foi comprida !
GoTo Voltar
End If
Next
End Sub

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

 
Postado : 10/09/2016 5:41 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Aqui deu erro em tempo de execucao 1004

O metodo Range do Objeto Worksheet Falhot

Cont = Cont + WR.Range("G" & x).Value '+ 1

 
Postado : 10/09/2016 6:32 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

desculpe Reinaldo, deu certo sim, foi falha minha aqui

Andre

 
Postado : 10/09/2016 6:56 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Reinaldo, resolvi abrir novamente este topico, para te pedir dentro desta macro que vc me ajeitou, para fazer interromper o loop caso a proxima linha for em branco, com isso a rotina ao qual esta macro se liga ficara mais rapida.

Digo isso, porque a minha macro principal chama varias outras macros e cada uma faz uma funcao, como : lancar as vendas feitas, atualizar o estoque, fazer envio de email ao cliente, somar a venda ao rol de compras do cliente, lancar produtos nos itens mais e menos vendidos entre outras coisas, dai a rotina demora um pouco, assim sendo tendera a ficar mais rapida.

Percebi tb que cono São tantas as coisas, se eu rodar a macro pelo F8, tudo e lancado corretamente, porem se eu acionar a macro no autoamtico, ai tem coisa que não lanca e tem coisas que lanca errado. Isso pode ocorrer , ou seja se for fazendo a macro rodar manulamente pelo F8 vai tudo bem e se automatico da varios falhas, porem sem acusar erro algum na macro .

Grato se puder interromper o loop apos encontrar alguma linha em branco.

Andre

 
Postado : 20/09/2016 6:10 pm
Página 2 / 2
Forum Jump:
  Tópico Anterior
Próximo Tópico