[Excel-Vba]: Macro cercare giorni settimana

[mmitola]

Buongiorno Ragazzi,
purtroppo mi ritrovo qui a darvi fastidio...so se sto esagerando, ma siete gli unici che potete darmi una mano.

Ho un altro problema.

io ho la seguente tabella:



che grazie a voi sono riuscito ad ordinare attraverso una macro.

Anche se non si visualizza bene cerco di descriverla brevemente:

1)Righe: Data
2)Colonne: Orari (del tipo:7.30;8.00;8.30)

Il mio obiettivo è quello di avere 7 tabelle (in 7 fogli diversi una per ogni giorno della settimana: Lunedì,Martedì,Mercoledì....).

Quindi la macro dovrebbe:

1)cercare nella tabella di partenza tutti i lunedì,i martedì, i mercoledì, ecc. ecc. e mettere nel rispettivo foglio il valore indicato.

2)Il formato delle tabelle "di arrivo" dev'essere lo stesso e quindi sulle righe le date (che rappresenteranno tutte lo stesso giorno della settimana) e sulle colonne le fasce orarie (7.30;8.00;8.30;......)


Spero davvero che possiate aiutarmi...scusatemi davvero tanto.


Grazie a tutti.

[Anthony47]

Sempre tabella pivot, partendo dai dati di base:
-in una ulteriore colonna inserisci l' intestazione GSett
-in riga 2 la formula

Codice: Seleziona tutto

=SE(VAL.NUMERO(A2);TESTO(A2;"ggg");"")

e copi verso il basso
-avvii la creazione tabella pivot, trascini il campo GSett nell' area PAGINA, per il resto come per l' altro quesito (viewtopic.php?f=26&t=94428#p540256)
-nella tabella risultante avrai un menu' a discesa da cui puoi scegliere quale "GSett" includere nel report; se questo non ti basta replichi N volte la stessa tabella e su ognuna visualizzerai un giorno diverso.

Buona macro
Ciao!

[mmitola]

Grazie per la preventiva risposta Anthony,

ma purtroppo mi sa che hai ragione con ciò che mi hai scritto alla fine del messaggio...."BUONA MACRO"!ihihihihhihih...

E cioè che io sarei maggiormente indirizzato per quella perchè è un file che devono maneggiare diverse persone....e una macro la ritengo "meno invasiva"....cioè loro cliccheranno su esegui e stop....mentre con le pivot non so mai cosa potrebbero combinarmi....

Mannaggia....scusatemi... un pò mi vergogno anche ad elemosinare queste info ma credetemi che se non ne avessi davvero bisogno non mi sarei mai permesso di tornare a chiedervi altre cose....

Scusatemi ancora...

[Flash30005]

Leggi prima quanto scritto da Anthony

poi spiega cosa dovrebbe essere inserito per ogni giorno settimana il N.Doc o il Lordo?
se devono essere separati, e vorresti entrambi i valori, i fogli dovranno essere 14 e non 7, o sbaglio?

ciao

[mmitola]

Si Flash,

hai perfettamente ragione. I fogli devono essere in tutto 14 (7 per ogni dato).

Quindi partendo dal Foglio 2 (in cui c'è la tabella Lordo) mi crei 7 fogli con i corrispondenti lun,mar,mer,.....

Stessa cosa dicasi per Foglio 3 (in cui c'è la tabella N Doc).

[Anthony47]

una macro la ritengo "meno invasiva"....cioè loro cliccheranno su esegui e stop....mentre con le pivot non so mai cosa potrebbero combinarmi....

Opinabile. I campi di una pivot non possono essere manipolati dagli utenti; una tabella compilata da una macro e' modificabile a piacere.
Se vuoi il tasto Start per aggiornare il contenuto della/delle pivot registri una macro mentre esegui "Aggiorna dati" della/delle tabelle che ti interessano, poi associ questa macro a un Pulsante.

Ciao

[mmitola]

Grazie Anthony,

proverò a fare così.

Tuttavia se mi potreste dare la possibilità di risolverlo anche attraverso una macro ve ne sarei grato.
Scusatemi ancora per il disturbo.

[Flash30005]

Oltre al foglio dati (Foglio1)

Crea 14 fogli
a 7 assegna i nomi dei giorni settimanali abbreviati (Lun, Mar, Mer, Gio, Ven, Sab, Dom)
agli altri 7 aggiungi una L (sta per Lordo) al giorno settimanale (LunL, MarL, MerL, GioL, VenL, SabL, DomL)

Sostituisci la macro precedente con questa

Codice: Seleziona tutto

Sub CompilaF()
Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim Ws1, Ws2, Ws3 As Worksheet
Set Ws1 = Worksheets("Foglio1")
Dim Data1 As Date

For F = 1 To Worksheets.Count
If Sheets(F).Name <> Ws1.Name Then
    Sheets(F).Select
    Cells.ClearContents
    Range("B1").FormulaR1C1 = "H"
    Range("B2").FormulaR1C1 = "M"
    Range("A2").FormulaR1C1 = "Data"
    Range("C1").FormulaR1C1 = "7"
    Range("C2").FormulaR1C1 = "30"
    Range("D1").FormulaR1C1 = "8"
    Range("D2").FormulaR1C1 = "0"
    Range("E1").FormulaR1C1 = "8"
    Range("E2").FormulaR1C1 = "30"
    Range("F1").FormulaR1C1 = "9"
    Range("G1").FormulaR1C1 = "9"
    Range("H1").FormulaR1C1 = "10"
    Range("I1").FormulaR1C1 = "10"
    Range("J1").FormulaR1C1 = "11"
    Range("K1").FormulaR1C1 = "11"
    Range("L1").FormulaR1C1 = "12"
    Range("M1").FormulaR1C1 = "12"
    Range("N1").FormulaR1C1 = "13"
    Range("O1").FormulaR1C1 = "13"
    Range("P1").FormulaR1C1 = "14"
    Range("Q1").FormulaR1C1 = "14"
    Range("R1").FormulaR1C1 = "15"
    Range("S1").FormulaR1C1 = "15"
    Range("T1").FormulaR1C1 = "16"
    Range("U1").FormulaR1C1 = "16"
    Range("V1").FormulaR1C1 = "17"
    Range("W1").FormulaR1C1 = "17"
    Range("X1").FormulaR1C1 = "18"
    Range("Y1").FormulaR1C1 = "18"
    Range("Z1").FormulaR1C1 = "19"
    Range("AA1").FormulaR1C1 = "19"
    Range("AB1").FormulaR1C1 = "20"
    Range("AC1").FormulaR1C1 = "20"
    Range("F2").FormulaR1C1 = "0"
    Range("C2:F2").Copy Destination:=Range("G2,K2,O2,S2,W2,AA2")
    Range("AD2").ClearContents
    Application.CutCopyMode = False
End If
Next F
Ws1.Select
UR1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row

For RR1 = 1 To UR1
If IsDate(Range("A" & RR1).Value) = False Then GoTo SaltaR
Data1 = Range("A" & RR1).Value
GR = Format(Data1, "ddd")
Set Ws2 = Worksheets(Worksheets(GR).Name)
Set Ws3 = Worksheets(Worksheets(GR).Name & "L")
If Mdata <> Data1 Then
Mdata = Data1
UR2 = Ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
UR3 = Ws3.Range("A" & Rows.Count).End(xlUp).Row + 1
Ws2.Range("A" & UR2).Value = Data1
Ws3.Range("A" & UR3).Value = Data1
Hr = Range("B" & RR1).Value
Mr = Range("C" & RR1).Value
    For CC2 = 3 To 29
        If Ws2.Cells(1, CC2).Value = Hr And Ws2.Cells(2, CC2).Value = Mr Then
        Ws2.Cells(UR2, CC2).Value = Ws1.Cells(RR1, 4).Value
        Ws3.Cells(UR3, CC2).Value = Ws1.Cells(RR1, 5).Value
       
        GoTo SaltaR
        End If
        If CC2 = 29 Then
        GoTo SaltaR
        End If
    Next CC2
Else
For RRH = RR1 To UR1
Hr = Range("B" & RRH).Value
Mr = Range("C" & RRH).Value
    For CC2 = 3 To 29
        If Ws2.Cells(1, CC2).Value = Hr And Ws2.Cells(2, CC2).Value = Mr Then
        Ws2.Cells(UR2, CC2).Value = Ws1.Cells(RRH, 4).Value
        Ws3.Cells(UR3, CC2).Value = Ws1.Cells(RRH, 5).Value
        RR1 = RRH
        GoTo SaltaR
        End If
        If CC2 = 29 Then
        RR1 = RRH
        GoTo SaltaR
        End If
    Next CC2
Next RRH
End If
SaltaR:
Next RR1
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Ciao