Agenda Semanal

2024 - VBA & Macros

Post Recente por guma 10 anos atrás

4 Posts

2 Usuários

0 Reactions

1,457 Visualizações

RSS

guma

(@guma)

Posts: 135

Estimable Member

Topic starter

Bom Dia

Estou criando uma planilha onde uma macro busca na planilha Cad_Comp (cadastro de compromisso ) onde eu cadastro meus compromissos, os compromissos da semana
e exibe numa planilha Agenda Semanal onde eu tenho os dias da semana corrente.

já tá funcionando pra segunda feira com o seguinte código

Private Sub Worksheet_Activate()
  Dim lng As Long
    Dim n As Long
    Dim wks1 As Worksheet
    Dim wks2 As Worksheet

    Set wks1 = ThisWorkbook.Sheets("Agenda Semanal")
    Set wks2 = ThisWorkbook.Sheets("Cad_Comp")
    
    wks1.Range("I3").FormulaLocal = "=HOJE()"
       
    wks1.Range("I3").Value = wks1.Range("I3").Value
    
    n = 8

        With wks2
        For lng = 2 To .Cells(.Rows.Count, "E").End(xlUp).Row
            If wks2.Range("E" & lng).Value = wks1.Range("C6").Value Then
            
                wks1.Cells(n, "C") = wks2.Range("C" & lng)
            
                n = n + 1
            Else
            End If
     Next lng
  End With
End Sub

O problema é que como as linhas vão ser diferentes pra cada dia, a unica forma que imaginei foi copiar todo o with para cada dia da semana, mas ai ela vai rodar a planilha 7 vezes. Alguém tem uma ideia melhor ?

Agenda da Semana.rar

Postado : 23/12/2014 8:06 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Uma possibilidade.
Formula em C6 alterada para C6=SemanaDe-(DIA.DA.SEMANA(SemanaDe;2)-1) de D6 ate I6 = celulaanteiror+1
Retirada formulas da linha 4
Rotina alterada:

Private Sub Worksheet_Activate()
Dim nCol
Dim wks1 As Worksheet, wks2 As Worksheet
Dim lng As Integer, nLin As Integer

Set wks1 = ThisWorkbook.Sheets("Agenda Semanal")
Set wks2 = ThisWorkbook.Sheets("Cad_Comp")
    wks1.Range("I3").Value = Date

wks1.Range("C8:I100").ClearContents

With wks2
    For lng = 2 To .Cells(.Rows.Count, "E").End(xlUp).Row
        nCol = Application.Match(.Cells(lng, "E"), wks1.Range("A6:I6"), 0)
        If Not IsError(nCol) Then
            nLin = wks1.Cells(.Rows.Count, nCol).End(xlUp).Row + 1
                wks1.Cells(nLin, nCol).Value = .Cells(lng, "C").Value
        Else
            End If
     Next lng
End With

End Sub

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

Postado : 23/12/2014 10:20 am

guma

(@guma)

Posts: 135

Estimable Member

Topic starter

Bom Dia

Acho que simplifiquei demais meu exemplo, na verdade estou fazendo um controle de estudos, e juntamente com as matérias a ser estudadas tem as revisões, achei que ia conseguir adaptar, mas é um pouco mais complicado, já que as revisões estão em mais de uma coluna e devem vir abaixo das matérias principais .
Postei um exemplo um pouco mais detalhado com o resultado esperado feito manualmente (Observação desabilitei o código para não estragar o exemplo) o objetivo é trazer o ID das revisões abaixo das matérias principais na agenda semanal.

Obrigado.

Agenda da Semana2.zip

Postado : 26/12/2014 8:19 am