[Excel'07/VBA] Trasformare funzione in codice

**leomac** · 20-07-2009, 12:33

Raga salve a tutti,

dovrei trasfromare le seguenti formule in codice VBA in quanto immettendole in VB mi da errore memoria insufficente. Difatti ho provato con la formula che segno in rosso dandnomi l'errore.
Il codice è il seguente:

codice:

Cells(R, C) = CDate(CStr(J) & "/" & CStr(M) & "/" & CStr(A))
Cells.Formula(R, C + 1) = "=IF((R, C)<>"""",PROPER(TEXT((R, C),""gggg"")),"""")" 
'Cells.Formula(R, C + 1) = "=SE(U88<>"";MAIUSC.INIZ(TESTO(U88;"gggg"));"")"
'Cells(R, C + 7) = SE(X88<>"";((X88-TRONCA(X88))*100/60)+TRONCA(X88);"")
'Cells(R, C + 8) = SE(X88<>"";((Y88-TRONCA(Y88))*100/60)+TRONCA(Y88);"")
'Cells(R, C + 9) = SE(X88<>"";((Y88-TRONCA(Y88))*100/60)+TRONCA(Y88);"")
'Cells(R, C + 10) = SE(X88<>"";((Z88-TRONCA(Z88))*100/60)+TRONCA(Z88);"")
'Cells(R, C + 11) = SE(X88<>"";AC88-AB88-AA88-AD88;"")
'Cells(R, C + 12) = SE(X88<>"";SE(AE88> M31;M31;AE88);"")
'Cells(R, C + 13) = SE(X88<>"";SE(AE88>M31;AE88-M31;0);"")
'Cells(R, C + 14) = SE(X88<>"";SE(GIORNO.SETTIMANA(U88)=1;AE88;0);"")
'Cells(R, C + 15) = SE(X88<>"";((AA88-TRONCA(AA88))*60/100)+TRONCA(AA88);"")
'Cells(R, C + 16) = SE(X88<>"";((AE88-TRONCA(AE88))*60/100)+TRONCA(AE88);"")
'Cells(R, C + 17) = INT((GIORNO(U88)-1)/7)+1
R = R + 1
'U88 = (R, C); X88 =(R, C+3); Y88 = (R, C+4); Z88 = (R, C+5); AA88 = (R, C+6)

grazie mille

**nicola75ss** · 20-07-2009, 13:24

Se commenti quella riga il resto del codice viene eseguito normalmente?

Mi sembra strano che la formula in sè ti dia problemi.

**leomac** · 20-07-2009, 16:49

nico forse da problemi in quanto è all'interno del codice che ti posto qui sotto.
Comunque ho provato ad inserire tre formule quelle delle cells +1, +7, +8 e da sempre lo stesso problema di memoria qualunque riga (+1 , +7, +8) vado a commentare.
La sub però funge tutta anche con la stringa cells(R,C). il problema lo da con le altre.
Magari dipende dal ciclo che insieme alle formule occupa troppa memoria?? ...

codice:

Private Sub CommandButton1_Click() 'INSERISCI MESE
Dim M As Integer
Dim A As Integer
Dim J As Integer
Dim Giorni As Integer
Dim firstrow As Integer
Dim firstcol As Integer
Dim R As Integer
Dim C As Integer

If ComboBox1.text = "" Then
        MsgBox "Nessun MESE selezionato." & Chr(13) & "Seleziona il MESE dall'elenco a discesa."
ElseIf ComboBox2.text = "" Then
        MsgBox "Nessun ANNO selezionato." & Chr(13) & "Seleziona l'ANNO dall'elenco a discesa."
Else:   Dim DataIn As Object
        A = ComboBox2.Value  ' prendi l'anno
        M = PrendiMese(ComboBox1.Value) ' prendi il mese
        firstrow = 88
        firstcol = 21
        R = firstrow
        C = firstcol
        Set zona = Range(Range(R, C), Range(R, C).End(xlDown)).Rows
        DataBox = CDate(CStr(M) & "/" & CStr(A))
        For Each DataIn In zona
            If DataIn = DataBox Then
                    MsgBox "Già cè"
                    Exit Sub
            Else: MsgBox "Non cè"
                    Giorni = Day(DateSerial(A, M + 1, 0))
                    For J = 1 To Giorni
                        Cells(R, C) = CDate(CStr(J) & "/" & CStr(M) & "/" & CStr(A))
                        Cells.Formula(R, C + 1) = "=IF((R, C)<>"""",PROPER(TEXT((R, C),""gggg"")),"""")"
                        'Cells.Formula(R, C + 1) = "=SE(U88<>"";MAIUSC.INIZ(TESTO(U88;"gggg"));"")"
	Cells.Formula(R, C + 7) = "=IF(((R, C+3))<>"""",(((R, C+3))-TRUNC((R, C+3)))*100/60)+TRUNC((R, C+3)),"""")"
                        'Cells(R, C + 7) = SE(X88<>"";((X88-TRONCA(X88))*100/60)+TRONCA(X88);"")
		Cells.Formula(R, C + 8) = "=IF((R, C+4)<>"""",(((R, C+4)-TRUNC((R, C+4)))*100/60)+TRUNC((R, C+4)),"""")"
                        'Cells(R, C + 8) = SE(X88<>"";((Y88-TRONCA(Y88))*100/60)+TRONCA(Y88);"")
                        'Cells(R, C + 9) = SE(X88<>"";((Y88-TRONCA(Y88))*100/60)+TRONCA(Y88);"")
                        'Cells(R, C + 10) = SE(X88<>"";((Z88-TRONCA(Z88))*100/60)+TRONCA(Z88);"")
                        'Cells(R, C + 11) = SE(X88<>"";AC88-AB88-AA88-AD88;"")
                        'Cells(R, C + 12) = SE(X88<>"";SE(AE88> M31;M31;AE88);"")
                        'Cells(R, C + 13) = SE(X88<>"";SE(AE88>M31;AE88-M31;0);"")
                        'Cells(R, C + 14) = SE(X88<>"";SE(GIORNO.SETTIMANA(U88)=1;AE88;0);"")
                        'Cells(R, C + 15) = SE(X88<>"";((AA88-TRONCA(AA88))*60/100)+TRONCA(AA88);"")
                        'Cells(R, C + 16) = SE(X88<>"";((AE88-TRONCA(AE88))*60/100)+TRONCA(AE88);"")
                        'Cells(R, C + 17) = INT((GIORNO(U88)-1)/7)+1
                        R = R + 1
                        'U88 = (R, C); X88 =(R, C+3); Y88 = (R, C+4); Z88 = (R, C+5); AA88 = (R, C+6)
                    Next
                    MsgBox "Completato!"
                    Exit Sub
            End If
        Next
End If
End Sub

**nicola75ss** · 20-07-2009, 18:46

Se hai la possibilità di caricare un fac-simile del file, anche rimuovendo i dati sensibili, magari domani gli dò un'occhiata.

**leomac** · 21-07-2009, 10:04

nico ti posto tutto ma nn credo dipenda dalle dimensioni del file anche perchè è un semplicissimo inserisci mese... il file di excel è "vuoto" e li compare la tabella con le formule della macro tutto qui. Cmq posto tutto:

codice:

Private Sub CommandButton3_Click() ' ANNULLA
Unload Me
End Sub

Private Sub CommandButton1_Click() 'INSERISCI MESE
Dim M As Integer
Dim A As Integer
Dim J As Integer
Dim Giorni As Integer
Dim firstrow As Integer
Dim firstcol As Integer
Dim R As Integer
Dim C As Integer

If ComboBox1.Text = "" Then
        MsgBox "Nessun MESE selezionato." & Chr(13) & "Seleziona il MESE dall'elenco a discesa."
ElseIf ComboBox2.Text = "" Then
        MsgBox "Nessun ANNO selezionato." & Chr(13) & "Seleziona l'ANNO dall'elenco a discesa."
Else:   Dim DataIn As Object
        A = ComboBox2.Value  ' prendi l'anno
        M = PrendiMese(ComboBox1.Value) ' prendi il mese
        firstrow = 88
        firstcol = 21
        R = firstrow
        C = firstcol
        Set zona = Range(Range("U88"), Range("U88").End(xlDown)).Rows
        DataBox = CDate(CStr(M) & "/" & CStr(A))
        For Each DataIn In zona
            If DataIn = DataBox Then
                    MsgBox "Già cè"
                    Exit Sub
            Else: MsgBox "Non cè"
                    Giorni = Day(DateSerial(A, M + 1, 0))
                    For J = 1 To Giorni
                        Cells(R, C) = CDate(CStr(J) & "/" & CStr(M) & "/" & CStr(A))
                        Cells.Formula(R, C + 1) = "=IF((R, C)<>"""",PROPER(TEXT((R, C),""gggg"")),"""")"
                        'Cells.Formula(R, C + 1) = "=SE(U88<>"";MAIUSC.INIZ(TESTO(U88;"gggg"));"")"
                        Cells.Formula(R, C + 7) = "=IF(((R, C+3))<>"""",(((R, C+3))-TRUNC((R, C+3)))*100/60)+TRUNC((R, C+3)),"""")"
                        'Cells(R, C + 7) = SE(X88<>"";((X88-TRONCA(X88))*100/60)+TRONCA(X88);"")
                        Cells.Formula(R, C + 8) = "=IF((R, C+4)<>"""",(((R, C+4)-TRUNC((R, C+4)))*100/60)+TRUNC((R, C+4)),"""")"
                        'Cells(R, C + 8) = SE(X88<>"";((Y88-TRONCA(Y88))*100/60)+TRONCA(Y88);"")
                        'Cells(R, C + 9) = SE(X88<>"";((Y88-TRONCA(Y88))*100/60)+TRONCA(Y88);"")
                        'Cells(R, C + 10) = SE(X88<>"";((Z88-TRONCA(Z88))*100/60)+TRONCA(Z88);"")
                        'Cells(R, C + 11) = SE(X88<>"";AC88-AB88-AA88-AD88;"")
                        'Cells(R, C + 12) = SE(X88<>"";SE(AE88> M31;M31;AE88);"")
                        'Cells(R, C + 13) = SE(X88<>"";SE(AE88>M31;AE88-M31;0);"")
                        'Cells(R, C + 14) = SE(X88<>"";SE(GIORNO.SETTIMANA(U88)=1;AE88;0);"")
                        'Cells(R, C + 15) = SE(X88<>"";((AA88-TRONCA(AA88))*60/100)+TRONCA(AA88);"")
                        'Cells(R, C + 16) = SE(X88<>"";((AE88-TRONCA(AE88))*60/100)+TRONCA(AE88);"")
                        'Cells(R, C + 17) = INT((GIORNO(U88)-1)/7)+1
                        R = R + 1
                        'U88 = (R, C); X88 =(R, C+3); Y88 = (R, C+4); Z88 = (R, C+5); AA88 = (R, C+6)
                    Next
                    MsgBox "Completato!"
                    Exit Sub
            End If
        Next
End If
End Sub

Private Sub CommandButton2_Click() 'ELIMINA MESE
Dim M As Integer
Dim A As Integer
Dim J As Integer
Dim Giorni As Integer
Dim chegiorno As String
Dim firstrow As Integer
Dim firstcol As Integer
Dim R As Integer
Dim C As Integer

If ComboBox1.Text = "" Then
        MsgBox "Nessun MESE selezionato." & Chr(13) & "Seleziona il MESE dall'elenco a discesa."
ElseIf ComboBox2.Text = "" Then
        MsgBox "Nessun ANNO selezionato." & Chr(13) & "Seleziona l'ANNO dall'elenco a discesa."
Else:   Dim DataIn As Object
        A = ComboBox2.Value  ' prendi l'anno
        M = PrendiMese(ComboBox1.Value) ' prendi il mese
        Set zona = Range(Range("A1"), Range("A1").End(xlDown)).Rows
        DataBox = CDate(CStr(M) & "/" & CStr(A))
        firstrow = 1
        firstcol = 1
        R = firstrow
        C = firstcol
        For Each DataIn In zona
            If DataIn = DataBox Then
                    MsgBox "Sei sicuro di cancellare questo mese? I dati andranno persi."
                    Giorni = Day(DateSerial(A, M + 1, 0))
                    For J = 1 To Giorni
                    Rows.Delete Shift:=xlUp
                    Next
                    MsgBox "Completato!"
                    Exit Sub
            Else: MsgBox "Non cè"
                    Exit Sub
            End If
        Next
End If
End Sub

Public Sub UserForm_Initialize()
'ANNO
ComboBox2.AddItem Year(Now)
ComboBox2.AddItem Year(Now) + 1
ComboBox2.AddItem Year(Now) + 2
ComboBox2.AddItem Year(Now) + 3

'MESE
Dim strA(12) As String
For i = 0 To 11
strA(i) = Now + (i - 12) * 30
strA(i) = Format(strA(i), "mmmm")
ComboBox1.AddItem StrConv(strA(i), vbUpperCase)
Next i

'SCRIVE ULTIMA DATA PRESENTE

Set ultimadata = Range("U88").End(xlDown)
If ultimadata <> 0 Then
Label2.Caption = "L'ULTIMA DATA INSERITA E':  " & StrConv(Format(ultimadata.Value, "mmmm"), vbUpperCase) _
                  & Chr(160) & Format(ultimadata.Value, "yyyy")
Else: Label2.Caption = "NON E' PRESENTE NESSUNA DATA."
End If
End Sub

**leomac** · 21-07-2009, 10:06

domenticavo di postarti quello il codice della funzione nel modulo:

codice:

Function PrendiMese(strItem As String) As Integer
  Select Case LCase(strItem)
    Case "gennaio"
        PrendiMese = 1
    Case "febbraio"
        PrendiMese = 2
    Case "marzo"
        PrendiMese = 3
    Case "aprile"
        PrendiMese = 4
    Case "maggio"
        PrendiMese = 5
    Case "giugno"
        PrendiMese = 6
    Case "luglio"
        PrendiMese = 7
    Case "agosto"
        PrendiMese = 8
    Case "settembre"
        PrendiMese = 9
    Case "ottobre"
        PrendiMese = 10
    Case "novembre"
        PrendiMese = 11
    Case "dicembre"
        PrendiMese = 12
  Case Else
    PrendiMese = 0
  End Select
End Function

e thx

**leomac** · 23-07-2009, 13:11

stavo leggendo che l'errore di memoria può essere dovuto anche al fatto che si fanno troppe dichiarazioni... può essere quello??

Discussione: [Excel'07/VBA] Trasformare funzione in codice

Strumenti discussione

Ricerca discussione

Visualizza

[Excel'07/VBA] Trasformare funzione in codice

Permessi di invio