Cambia Anno

Hai un problema con Excel?

Nuova discussione

Cambia Anno
di Mauro (utente non iscritto) data: 03/01/2014 10:13:29
Buon giorno a TUTTI, ho parecchi fogli di lavoro come quello allegato e a ogni inizio anno devo modificare le date, allora ho provato a modificarle con una macro, ho fatto delle prove e ho visto però che nel 2016 (anno bisestile) mi da degli errori ( no errori ma tipo il 1-3-16 lo trasforma in 29-2-16 ecc..).
In che modo posso risolvere?
Grazie, allego il file

di Grograman (utente non iscritto) data: 03/01/2014 11:15:01
Il codice sotto è brutto e manca ancora di eliminare i giorni che non fanno parte del mese, ma prova intanto questo al momento non posso fare di meglio!!

Sub Happy_New_Year()
Dim i As Integer, iNY As Integer
Dim x As Long, z As Long
iNY = 2015
Dim rngMese As Range
iNY = Year(Range("B8")) + 1
z = 8
i = IIf(Bisestile(iNY), 366, 365)
  For x = 1 To 12 ' 12
    i = 7 + 36 * (x - 1)
    Debug.Print i
    Set rngMese = Range("B" & z & ":B" & z + 30)
    rngMese = "=DATE(" & iNY & "," & x & ",ROW()-" & i & ")"
    rngMese = rngMese.Value
    rngMese.Offset(0, -1).FormulaR1C1 = "=UPPER(LEFT(TEXT(RC[1],""GGGG""),1))"
    rngMese.Offset(0, -1) = rngMese.Offset(0, -1).Value
    z = z + 36
    Set rngMese = Nothing
  Next x
End Sub

Cambia Anno
di Mauro (utente non iscritto) data: 03/01/2014 11:29:45
Grazie per il tuo intervento, mi da errore di compilazione, Sub o Function non definita e mi evidenzia: Bisestile
i = IIf(Bisestile(iNY), 366, 365)

di Grograman (utente non iscritto) data: 03/01/2014 11:37:13
Hai ragione sono un cretino:

Sub Happy_New_Year()
Dim i As Integer, iNY As Integer
Dim x As Long, z As Long
iNY = 2015
Dim rngMese As Range
iNY = Year(Range("B8")) + 1
z = 8
i = IIf(Bisestile(iNY), 366, 365)
  For x = 1 To 12 ' 12
    i = 7 + 36 * (x - 1)
    Debug.Print i
    Set rngMese = Range("B" & z & ":B" & z + 30)
    rngMese = "=DATE(" & iNY & "," & x & ",ROW()-" & i & ")"
    rngMese = rngMese.Value
    rngMese.Offset(0, -1).FormulaR1C1 = "=UPPER(LEFT(TEXT(RC[1],""GGGG""),1))"
    rngMese.Offset(0, -1) = rngMese.Offset(0, -1).Value
    z = z + 36
    Set rngMese = Nothing
  Next x
End Sub
Public Function Bisestile(Anno As Integer) As Boolean
  Bisestile = ((Anno Mod 4) = 0 And (Anno Mod 100)) Or (Anno Mod 400) = 0
End Function

di Grograman (utente non iscritto) data: 03/01/2014 11:37:58
Che poi al momento non serve nemmeno visto che non ho messo il controllo sui giorni
Cambia Anno
di Mauro (utente non iscritto) data: 03/01/2014 12:04:36
Ho provato, mi inserisce dei numeri nella colonna "A" dove ho l'iniziale del giorno della settimana, poi dopo il 28 febbraio continua con marzo e cambia il formato data da gg/mm/yyyy con mm/gg/yyyy:

V 02/01/2015
L 02/02/2015
L 02/03/2015
G 02/04/2015
S 02/05/2015
M 02/06/2015
G 02/07/2015
D 02/08/2015
M 02/09/2015
V 02/10/2015
L 02/11/2015
M 02/12/2015
2 2/13/2015
2 2/14/2015
2 2/15/2015
2 2/16/2015
2 2/17/2015
2 2/18/2015
2 2/19/2015
2 2/20/2015
2 2/21/2015
2 2/22/2015
2 2/23/2015
2 2/24/2015
2 2/25/2015
2 2/26/2015
2 2/27/2015
2 2/28/2015
S 03/01/2015
M 03/02/2015
M 03/03/2015

di Mister_x (utente non iscritto) data: 03/01/2014 16:34:43
ciao mauro

io farei questo in un altro modo con una sub() strutturata in questa maniera dove non dovrei piu' definire se l'anno e' bisestile o no, con i tuoi dati esposti nel file

riallego il tuo file con la sub() inserita

ciao MIster_x

Sub Cambia_anno()
Dim g As Long, m As Long
Dim Nriga As Long
Dim anno_seriale As Long
Dim Giorno As String
anno_seriale = Year(Date)
For m = 1 To 12
Giorno = "1 " & m & " " & anno_seriale
Nriga = Application.Choose(m, 8, 44, 80, 116, 152, 188, 224, 260, 296, 332, 368, 404)
  For g = 1 To Day(Application.EoMonth(CDate(Giorno), 0))
   Giorno = g & " " & m & " " & anno_seriale
   Cells(Nriga, "B") = CDate(Giorno)
   Cells(Nriga, "A") = Application.Choose(Weekday(CDate(Giorno)), "D", "L", _
                                                     "M", "M", "G", "V", "S")
   Cells(Nriga, "H") = CDate(Giorno)
   Cells(Nriga, "G") = Application.Choose(Weekday(CDate(Giorno)), "D", "L", _
                                                     "M", "M", "G", "V", "S")
    Nriga = Nriga + 1
    If g = 27 Then
      Cells(Nriga + 1, "A") = ""
      Cells(Nriga + 1, "B") = ""
      Cells(Nriga + 1, "H") = ""
      Cells(Nriga + 1, "G") = ""
    End If
  Next g
Next m
End Sub

di scossa data: 03/01/2014 16:56:06
Propongo come alternativa la sottostante sub, da richiamare dopo aver impostato nella cella B8 l'1/1 dell'anno voluto.
Si potrebbe anche richiamare in automatico con l'evento change di quella cella.

Sub cambiaanno2()
Dim j As Integer, m As Integer
Dim k As Long
Dim dStart As Date
Dim dData As Date
Dim nGiorni As Integer

nGiorni = (CDate("31/12/" & Year(Foglio14.Cells(8, 2).Value)) - CDate("01/01/" & Year(Foglio14.Cells(8, 2).Value)) + 1)
k = 7
dStart = Foglio14.Cells(8, 2).Value - 1

For j = 1 To nGiorni
  k = k + 1
  dData = dStart + j
  Foglio14.Cells(k, 2).Value = dData
  Foglio14.Cells(k, 1).Value = UCase(Left(VBA.WeekdayName(VBA.Weekday(dData, vbMonday), True), 1))
  If dData = DateSerial(Year(dData), Month(dData) + 1, 0) Then
    For m = k + 1 To (k + 31 - Day(dData))
      Foglio14.Cells(m, 1).ClearContents
      Foglio14.Cells(m, 2).ClearContents
    Next m
    k = k + (36 - Day(dData))
  End If
Next
End Sub

Cambia Anno
di Mauro (utente non iscritto) data: 03/01/2014 17:46:36
Mister_x, ho scaricato il file e mi da errore di run-time '438' e mi evidenzia la riga:
For g = 1 To Day(Application.EoMonth(CDate(Giorno), 0))
Cambia Anno
di Mauro (utente non iscritto) data: 03/01/2014 17:56:44
Ciao Scossa ho provato la tua sub() ed è perfetta.
Grazie Mauro

di Mister_x (utente non iscritto) data: 03/01/2014 23:01:22
ciao mauro

visto adesso il tuo intervento in base all'errore dato , non mi sono accorto che tu utilizzi la versione 2003, nella quale la funzione EoMonth() in vba non e' supportata, in questo caso io per utilizzarla uso una funzione creata per questo lavoro la quale mi riporta l'ultimo giorno del mese della data che inserisco quindi per la tua versione di excel e per quelle inferiori bisogna utilizzare questo accorgimento, mentre per la 2007 e sup e' stata integrata

ciao Mister_x

Sub Cambia_anno()
Dim g As Long, m As Long
Dim Nriga As Long
Dim anno_seriale As Long
Dim Giorno As String
anno_seriale = Year(Date)
For m = 1 To 12
Giorno = "1 " & m & " " & anno_seriale
Nriga = Choose(m, 8, 44, 80, 116, 152, 188, 224, 260, 296, 332, 368, 404)
  For g = 1 To Day(EOMonth(CDate(Giorno)))
   Giorno = g & " " & m & " " & anno_seriale
   Cells(Nriga, "B") = CDate(Giorno)
   Cells(Nriga, "A") = Choose(Weekday(CDate(Giorno)), "D", "L", _
                                                     "M", "M", "G", "V", "S")
   Cells(Nriga, "H") = CDate(Giorno)
   Cells(Nriga, "G") = Choose(Weekday(CDate(Giorno)), "D", "L", _
                                                     "M", "M", "G", "V", "S")
    Nriga = Nriga + 1
    If g = 27 Then
      Cells(Nriga + 1, "A") = ""
      Cells(Nriga + 1, "B") = ""
      Cells(Nriga + 1, "H") = ""
      Cells(Nriga + 1, "G") = ""
    End If
  Next g
Next m
End Sub

Public Function EOMonth(DataMese As Date)
   EOMonth = DataMese - Day(DataMese) + 45
   EOMonth = EOMonth - Day(EOMonth)
End Function

di scossa (utente non iscritto) data: 03/01/2014 23:45:28
cit. Mister_X: " non mi sono accorto che tu utilizzi la versione 2003, nella quale la funzione EoMonth() in vba non e' supportata"

Basta installare "strumenti di analisi" e mettere, nel progetto VBA, i riferimenti a atpvbaen.xls

P.S.: per ricavare l'ultimo giorno del mese preferisco la seguente UDF:
Function EoMonth(ByVal MiaData As Date) As Date EoMonth = DateSerial(Year(MiaData), Month(MiaData) + 1, 0) End Function
di Mister_x (utente non iscritto) data: 04/01/2014 00:36:41
ciao Scossa

terro conto per un futuro anche della tua UDF()

per strumenti di analisi nella versione mia 2003 e' gia' attivato il problema sta nel spiegare agli utenti come attivare strumenti di analisi e le librerie aggiunte a tale scopi,
in base a questo preferisco non attivare sul mio excel 2003 tali librerie per non continuare a dare spiegazioni a riguardo
comunque Scossa se esiste un modo di farle attivare in automatico tali passaggi bel venga tale spiegazione con un esempio pratico tipo, prendi in esame la mia sub() proposta e modificami all'inizio tali passaggi di attivazione

ciao Mister_x

di scossa (utente non iscritto) data: 04/01/2014 10:33:36
cit. Mister_x: "... il problema sta nel spiegare agli utenti come attivare strumenti di analisi e le librerie aggiunte a tale scopi"

Condivido completamente il tuo pensiero, infatti anch'io nella mia proposta ho usato direttamente

If dData = DateSerial(Year(dData), Month(dData) + 1, 0) Then

senza nemmeno usare l'udf.

cit. Mister_x: "... se esiste un modo di farle attivare in automatico tali passaggi bel venga tale spiegazione ...."

Si potrebbe usare l'evento Open di ThisWorkbook, inserendo il codice sotto (adattando il percorso relativo al proprio pc):

Private Sub Workbook_Open()
  On Error Resume Next
  ThisWorkbook.VBProject.References.AddFromFile "C:Program Files (x86)Microsoft OfficeOFFICE11LibreriaAnalysisATPVBAEN.XLA"
  On Error GoTo 0 'se seguono altre istruzioni
End Sub

di Mister_x (utente non iscritto) data: 04/01/2014 11:41:23
ciao Scossa
visto adesso il tuo messaggio in base a indicizzazione di una libreria,
il problema quindi rimane sempre, dato come facciamo a spiegare all'utente dove andare a prendere tale libreria sul suo pc con comandi , DOS ,

Per la funzione EoMonth() non avevo minimamente pensato che passando parametri alla funzione vba DateSerial() dando il valore mese + 1 e il giorno a valore 0 questi riportasse sempre l'ultimo giorno del mese precedente, quindi memorizzero questo passaggi al fine di abbandonare definitivamente quando servira' la funzione EoMonth() dato che il calcolo lo possimo fare sul mese di DateSerial()

quindi per non avere problemi la modifica da fare alla mia sub() cosi da utilizzaròa su qualsiasi versione di excel e' sostanzialmente cosi
prima
For g = 1 To Day(EOMonth(CDate(Giorno)))
dopo
For g = 1 To Day(DateSerial(Year(Giorno), Month(Giorno) + 1, 0))

Grazie per la dritta
ciao MIster_x
di scossa data: 04/01/2014 13:13:57
cit.: "...il problema quindi rimane sempre, dato come facciamo a spiegare all'utente dove andare a prendere tale libreria sul suo pc con comandi ..."

Hai perfettamente ragione, purtroppo "Analysis Tool Pack Visual Basic for Applications English" non ha un GUID, quindi non puoi utilizzare il metodo .AddFromGuid.
Del resto buna parte delle funzioni dell'ATP sono facilmente implementabili con le funzioni native.
di mb (utente non iscritto) data: 04/01/2014 16:29:30
buon pomeriggio

guardando questo argomento e provandolo, forse sbaglio qualcosa, ma inserendo i dati:
C8 5
C9 10
C10 20

nella cella riepilogo 1 trim mi aspetterei come risultato 35 in cella E2 invece il risultato è 11,67??
grazie per l'attenzione
Cambia Anno
di Mauro (utente non iscritto) data: 05/01/2014 10:17:00
Ciao mb, nella cella E2 da come risultato la media del trimestre.
Ciao Mauro
di mb (utente non iscritto) data: 05/01/2014 20:47:44
Grazie Mauro per la precisazione
alla prossima

Vuoi Approfondire?