Separare cifre cella excel con VBA

Question

Buongiorno a tutti, nel file allegato ho messo le spiegazioni di come mi abbisognerebbe.

Piccolo riassunto:

In una cella ho l' intero ammontare di una fattura, tale importo vorrei che si riportasse nelle celle previste per la cedola di versamento ma searando le cifre e se fosse il caso che le celle precedenti alle cifre fossero vuote, si mettesse il segno "#".

Naturalmente il tutto con VBA o in maniera automatica per non riportare sempre le cifre "a mano".

https://skydrive.live.com/#cid=09759C744DA4D812&id=9759C744DA4D812!103

ringrazio anticipatamente

Answer 1

Buongiorno a tutti, nel file allegato ho messo le spiegazioni di come mi abbisognerebbe.

Piccolo riassunto:

In una cella ho l' intero ammontare di una fattura, tale importo vorrei che si riportasse nelle celle previste per la cedola di versamento ma searando le cifre e se fosse il caso che le celle precedenti alle cifre fossero vuote, si mettesse il segno "#".

Naturalmente il tutto con VBA o in maniera automatica per non riportare sempre le cifre "a mano".

https://skydrive.live.com/#cid=09759C744DA4D812&id=9759C744DA4D812!103

ringrazio anticipatamente

Oltre alla risposta di Maurizio, vedi questa(ci ho lavorato un po' e quindo la posto... ;-)):

Public Sub m()

    Dim sInt As String

    Dim sDec As String

    Dim s As String

    Dim lVirgola As Long

    Dim lng As Long

    Dim sh As Worksheet

    Set sh = ThisWorkbook.Worksheets("Foglio1")

    With sh

        s = .Range("P20").Value

        lVirgola = InStr(s, ",")

        For lng = 1 To lVirgola

            If IsNumeric(Mid(s, lng, 1)) Then

                sInt = sInt & Mid(s, lng, 1)

            End If

        Next

        For lng = lVirgola + 1 To Len(s)

            If IsNumeric(Mid(s, lng, 1)) Then

                sDec = sDec & Mid(s, lng, 1)

            End If

        Next

        .Range("B48:I48, N48:U48").Value = "#"

        .Range("K48:L48,V48:X48").Value = ""

        sInt = Format(sInt, "00000000")

        For lng = 1 To Len(sInt)

            If Mid(sInt, lng, 1) <> "0" Then

                .Cells(48, lng + 1).Value = Mid(sInt, lng, 1)

                .Cells(48, lng + 13).Value = Mid(sInt, lng, 1)

            End If

        Next

        sDec = Format(sDec, "00")

        For lng = 1 To Len(sDec)

            .Cells(48, lng + 10).Value = Mid(sDec, lng, 1)

            .Cells(48, lng + 22).Value = Mid(sDec, lng, 1)

        Next

    End With

    Set sh = Nothing

End Sub

Answer 2

Ciao everestmilton,

un modo... Con la funzione:

• Private Function GetNumAsString(ByVal rng As Excel.Range) As String

Dim r As String

Dim s As String

Dim l As Long

    s = String$(11, "#")

    r = Format$(rng.Value, "#.00")

    l = Len(r)

    Mid$(s, 11 - l + 1, l) = Replace(r, Format$(0, "."), " ")

    GetNumAsString = s

End Function

usata per esempio così:

• Public Sub WriteNumAsString()

Dim wshInp  As Excel.Worksheet

Dim rngInp  As Excel.Range

Dim wshOut  As Excel.Worksheet

Dim rngOut  As Excel.Range

Dim s As String

Dim i As Long

    Set wshInp = ThisWorkbook.Worksheets("Foglio1")

    Set wshOut = ThisWorkbook.Worksheets("Foglio1")

    Set rngInp = wshInp.Range("A1")

    Set rngOut = wshInp.Range("A4")

    s = GetNumAsString(rngInp)

    For i = 1 To 11

      rngOut.Offset(, i - 1).Value = Mid$(s, i, 1)

    Next

    Set rngOut = Nothing

    Set rngInp = Nothing

    Set wshOut = Nothing

    Set wshInp = Nothing

End Sub

dove sostituirai "Foglio1", "A1" e "A4" con gli opportuni riferimenti.

Answer 3

Ciao everestmilton,

grazie del riscontro.

Answer 4

Un calorosissimo saluto e ringraziamento sia a Maurizio che a Mauro, funzionano alla mia bisogna in maniera ineccepibile.

Siete fantastici, grazie

E beh... ;-)

Grazie del cortese riscontro.

Ciao e alla prossima.

Answer 5

Un calorosissimo saluto e ringraziamento sia a Maurizio che a Mauro, funzionano alla mia bisogna in maniera ineccepibile.

Siete fantastici, grazie