Newsgroup: it.comp.lang.visual-basic
Titolo: Auito in Excel

Ciao mi chiamo shari
Lavoro con excel e non riesco a fare una cosa che sembra molto banale ,ma
non mi riesce. se qualcuno può aiutarmi.
Il problema consiste nelle funzioni di
arrotondamento che non riesco ad arrotondare le cifre con le proprietà di
numro.valuta o contabilità .Per esempio risultato di una formula in una
tabella normale è 880.779 lire come posso ottenere arrotondamento di 1.000
oppure di 10.000 e estenderlo per tutta una colonna? vi ringrazio tanto ciao

Incolla questo codice in un modulo VBA (da Excel premi ALT+F11 e ti si
apre l'editor di VBA, dal menu inserisci seleziona modulo) e provalo.
Poi da Excel, menu strumenti, macro, esegui RoundedAndFormatted.
Lo devi fare nel foglio che contiene i dati da formattare
Spero ti possa risolvere il problema.
Ciao
Adriano
Option Explicit
Sub RoundedAndFormatted()
Dim ColonnaDaFormattare As String
Dim TipoArrotondamento As String
Dim Arrotondoper As String
Dim IlDovuto As Currency
Dim ArrotondoNNN As Integer
Dim CCIdx As Long
Dim RRIdx As Long
Dim RRIdxStop As Long
Dim FFRange As Range
Dim Esito As String
ColonnaDaFormattare = InputBox("Inserire la lettera identificativa della
Colonna:", "Shari in Excel Application")
Esito = ControllaCDF(CStr(ColonnaDaFormattare))
If Len(Esito) > 2 Then
    MsgBox CStr(Right(Esito, Len(Esito) - 3)), vbOKOnly, "Errore
indicazione colonna"
    Exit Sub
End If
ColonnaDaFormattare = Esito
RRIdx = 1
Esito = MsgBox("La prima riga della colonna é l'intestazione?", vbYesNo,
"Non dire bugie")
If Esito = vbYes Then RRIdx = 2
RRIdxStop = Rows.Count
Esito = MsgBox("Nella colonna i dati sono continui?" & Chr(13) & Chr(10)
& _
    "(Rispondere SI se non vi sono spazi o valori nulli intervallati tra
valori da considerare)", vbYesNo, "Non dire bugie")
If Esito = vbYes Then
    Set FFRange =
ActiveSheet.Columns(CLng(ColonnaDaFormattare)).Find("",
LookIn:=xlValues)
    RRIdxStop = FFRange.Row - 1
End If
TipoArrotondamento = "+"
Esito = MsgBox("Arrotondare per difetto?" & Chr(13) & Chr(10) & _
        "Rispondere No se si intende arrotondare per eccesso", vbYesNo,
"Non dire bugie")
If Esito = vbYes Then TipoArrotondamento = "-"
ancora:
Esito = InputBox("Indicare l'arrotondamento" & Chr(13) & Chr(10) & _
        "Ammesso 10, 100, 1000", "Non dire bugie")
Arrotondoper = Trim(Esito)
If Len(Arrotondoper) = 0 Then GoTo ancora
Select Case CLng(Arrotondoper)
    Case 10
    Case 100
    Case 1000
    Case Else
        MsgBox "Valore non ammesso"
        GoTo ancora
End Select
On Error Resume Next
For RRIdx = RRIdx To RRIdxStop
    IlDovuto = CCur(ActiveSheet.Cells(RRIdx,
CInt(ColonnaDaFormattare)).Value)
    ArrotondoNNN = CInt(IlDovuto * Arrotondoper Mod CLng(Arrotondoper))
    If ArrotondoNNN <> 0 Then
        Select Case TipoArrotondamento
            Case "-"
                IlDovuto = IlDovuto - (ArrotondoNNN * (1 /
CLng(Arrotondoper)))
            Case "+"
                IlDovuto = IlDovuto + (ArrotondoNNN * (1 /
CLng(Arrotondoper)))
            Case Else
        End Select
    End If
    ActiveSheet.Cells(RRIdx, CInt(ColonnaDaFormattare)) = IlDovuto
    ActiveSheet.Cells(RRIdx, CInt(ColonnaDaFormattare)).NumberFormat =
"_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Next RRIdx
    Range("A1").Select
End Sub
Function ControllaCDF(CDF As String) As String
    Dim Colonna As String
    Dim LenColonna As Integer
    Dim Pos1Colonna As String * 1
    Dim Pos2Colonna As String * 1
    Dim StrPos As Integer
    Dim ChrPos As Integer
    Dim ColonnaA2N As Integer
 
    Colonna = Trim(UCase(CDF))
    LenColonna = Len(Colonna)
    Select Case LenColonna
        Case 0
            ControllaCDF = "00 Nessuna Colonna Indicata"
            Exit Function
        Case 1
            StrPos = InStr(1, Colonna, "0123456789")
            If StrPos > 0 Then
                ControllaCDF = "00 Indicazione errata. Gli
identificativi di colonna sono composti solo da caratteri alfabetici"
                Exit Function
            End If
            If Asc(Colonna) < Asc("A") Then
                ControllaCDF = "00 Indicata Colonna non supportata: " &
Colonna
                Exit Function
            End If
            If Asc(Pos1Colonna) > Asc("Z") Then
                ControllaCDF = "00 Indicata Colonna non supportata: " &
Colonna
                Exit Function
            End If
        Case 2
            Pos1Colonna = Trim(Left(Colonna, 1))
            Pos2Colonna = Trim(Right(Colonna, 1))
            StrPos = InStr(1, Pos1Colonna, "0123456789")
            If StrPos > 0 Then
                ControllaCDF = "00 Indicazione errata. Gli
identificativi di colonna sono composti solo da caratteri alfabetici"
                Exit Function
            End If
            StrPos = InStr(1, Pos2Colonna, "0123456789")
            If StrPos > 0 Then
                ControllaCDF = "00 Indicazione errata. Gli
identificativi di colonna sono composti solo da caratteri alfabetici"
                Exit Function
            End If
            If Asc(Pos1Colonna) < Asc("A") Then
                ControllaCDF = "00 Indicata Colonna non supportata: " &
Colonna
                Exit Function
            End If
            If Asc(Pos2Colonna) < Asc("A") Then
                ControllaCDF = "00 Indicata Colonna non supportata: " &
Colonna
                Exit Function
            End If
            If Asc(Pos1Colonna) > Asc("Z") Then
                ControllaCDF = "00 Indicata Colonna non supportata: " &
Colonna
                Exit Function
            End If
            If Asc(Pos2Colonna) > Asc("Z") Then
                ControllaCDF = "00 Indicata Colonna non supportata: " &
Colonna
                Exit Function
            End If
            If Asc(Pos1Colonna) > Asc("I") Then
                ControllaCDF = "00 Indicata Colonna non supportata: " &
Colonna
                Exit Function
            End If
            If Asc(Pos1Colonna) <= Asc("I") Then
                If Asc(Pos2Colonna) > Asc("V") Then
                    ControllaCDF = "00 Indicata Colonna non supportata:
" & Colonna
                    Exit Function
                End If
            End If
        Case Else
            ControllaCDF = "00 Indicata Colonna non indirizzabile: " &
Colonna
            Exit Function
    End Select
    If LenColonna = 1 Then
        ColonnaA2N = CInt(Asc(Colonna) - 64)
    Else
        ColonnaA2N = CInt((26 * (Asc(Pos1Colonna) - 64)) +
(Asc(Pos2Colonna) - 64))
    End If
    ControllaCDF = CStr(ColonnaA2N)
End Function