Notifications
Clear all

Loop em VBA com datas

8 Posts
3 Usuários
0 Reactions
1,400 Visualizações
(@ericks)
Posts: 17
Active Member
Topic starter
 

Como faço para incluir os comandos (funções)

Sub teste()

aut_total "08/01/14", Range("B10"), Range("B6")
aut_total "08/02/14", Range("C10"), Range("C6")
aut_total "08/03/14", Range("D10"), Range("D6")
aut_total "08/04/14", Range("E10"), Range("E6")
aut_total "08/05/14", Range("F10"), Range("F6")
aut_total "08/06/14", Range("G10"), Range("G6")
aut_total "08/07/14", Range("H10"), Range("H6")
aut_total "08/08/14", Range("I10"), Range("I6")
aut_total "08/09/14", Range("J10"), Range("J6")
aut_total "08/10/14", Range("K10"), Range("K6")
aut_total "08/11/14", Range("L10"), Range("L6")
aut_total "08/12/14", Range("M10"), Range("M6")
aut_total "08/13/14", Range("N10"), Range("N6")
aut_total "08/14/14", Range("O10"), Range("O6")

End Sub

em um loop? Assim nâo precisaria trocar as datas uma a uma quando o mês muda.

 
Postado : 27/08/2014 9:34 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Desculpe mas eu ainda não entendi, se poder explicar melhor...

Att

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

 
Postado : 27/08/2014 9:49 am
(@ericks)
Posts: 17
Active Member
Topic starter
 

Algo como

for i = "08/01/14" to "08/14/14"
aut_total i, Range("B10"), Range("B6")
Next

só que variando os Range também. Vou colocar a função também, pode ser que dê pra mudar algo nela:

Function aut_total(data As String, cell1 As Range, cell2 As Range)
'
' Soma o valor absoluto dos pedidos aprovados + valor do frete para o dia atual
'
'
'
Sheets("BASE").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AP$50000").AutoFilter Field:=8, Criteria1:= _
data
ActiveSheet.Range("$A$1:$AP$50000").AutoFilter Field:=27, Criteria1:= _
"Automático"

Sheets("FRETE").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$H$20000").AutoFilter Field:=4, Criteria1:= _
data
ActiveSheet.Range("$A$1:$H$20000").AutoFilter Field:=7, Criteria1:= _
"Automático"
Sheets("Acompanhamento Diário").Select
cell1.Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,BASE!C20,FRETE!C3)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
cell2.Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(102,FRETE!C1)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'remover auto filtros
Sheets("BASE").Select
Selection.AutoFilter
Sheets("FRETE").Select
Selection.AutoFilter
Sheets("Acompanhamento Diário").Select
End Function

 
Postado : 27/08/2014 10:01 am
(@gtsalikis)
Posts: 2373
Noble Member
 

Não entendi muito bem, mas vê se ajuda:

Sub teste_GT()

Dim i As Long
Dim aut As Date

aut = "06/01/14"

For i = 1 To 14

    aut_total Data + i, Cells(10, i + 1), Cells(6, i + 1)

Next i

End Sub

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 27/08/2014 10:09 am
(@ericks)
Posts: 17
Active Member
Topic starter
 

Cara quase deu certo, mas na data ele itera o 06, que no meu caso é o mês, porque eu não consegui usar a data no formato "dd/mm/aa" porque na hora que eu faço o filtro ele não achava nada. O filtro está funcionando, mas só com a data no formato "mm/dd/aa". Tem como esse for iterar o dia desse modo?
Obrigado

 
Postado : 29/08/2014 8:22 am
(@gtsalikis)
Posts: 2373
Noble Member
 

Eu cometi um erro, no lugar dessa linha:

aut_total Data + i, Cells(10, i + 1), Cells(6, i + 1)

Deve ser esta:

aut_total aut + i, Cells(10, i + 1), Cells(6, i + 1)

O código está aumentando a data de 1 em 1 (valor de i), sendo que cada dia tem o valor de 1. Portanto, não pode estar aumentando meses.

Mas, reitero, eu não entendi o que você quer, apenas fiz uma sugestão pra te ajudar nesso código (sem a planilha fica mais difícil entender o que vc precisa).

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 29/08/2014 8:43 am
(@ericks)
Posts: 17
Active Member
Topic starter
 

Anexei a planilha com um exemplo, acho que fica mais claro.
Obrigado

 
Postado : 29/08/2014 9:23 am
(@gtsalikis)
Posts: 2373
Noble Member
 

Cara, não pude ver com detalhes (to sem tempo mesmo, mas vê se era isso):

Sub teste()

    ActiveSheet.DisplayPageBreaks = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Dim i As Long
    Dim data As Date

    data = Format("08/01/14", "mm/dd/yyyy")

    For i = 0 To 29
        
        aut_total data + i, Cells(10, i + 2), Cells(6, i + 2)
    
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

Function aut_total(data As String, cell1 As Range, cell2 As Range)
'
' Soma o valor absoluto dos pedidos aprovados + valor do frete para o dia atual
'
'
'
    data = Format(data, "mm/dd/yyyy")
    Sheets("BASE").Select
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AP$50000").AutoFilter Field:=8, Criteria1:= _
        data
    ActiveSheet.Range("$A$1:$AP$50000").AutoFilter Field:=27, Criteria1:= _
        "Automático"
        
        
    Sheets("FRETE").Select
    Range("A1").Select
    Selection.AutoFilter
   ActiveSheet.Range("$A$1:$H$20000").AutoFilter Field:=4, Criteria1:= _
        data
    ActiveSheet.Range("$A$1:$H$20000").AutoFilter Field:=7, Criteria1:= _
        "Automático"
    Sheets("Acompanhamento Diário").Select
    cell1.Select
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,BASE!C20,FRETE!C3)"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    cell2.Select
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(102,FRETE!C1)"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'remover auto filtros
    Sheets("BASE").Select
    Selection.AutoFilter
    Sheets("FRETE").Select
    Selection.AutoFilter
    Sheets("Acompanhamento Diário").Select
End Function

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 29/08/2014 10:10 am