Condividi:        

INSERIRE PUNTO IN NUMERO

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

INSERIRE PUNTO IN NUMERO

Postdi miko » 15/02/19 23:12

salve,
in una cella formato testo inserisco un numero, variabile, con eventuali decimali privo di punteggiatura
per le migliaia, devo in automatico inserire il punto;
se ad esempio inserisco 123,00 oppure 123,45 il numero rimane identico;
se invece inserisco 1234,00 oppure 1234,56 il numero si deve trasformare in
1.234,00 oppure 1.234,56 dove si nota la presenza del punto.
così se il numero inserito è 12345 deve diventare 12.345
in pratica si tratta di inserire il punto per mille, migliaia, milioni
sto procedendo in questo modo:
introduco in una matrice le singole cifre del numero escludendo la virgola ed i decimali
Codice: Seleziona tutto
Sub INSERISCI_PUNTO()

Dim CL As Range

Dim vNum()

Set CL = Worksheets("Foglio1").Range("B4")

For i = 1 To Len(CL.Value)

ReDim Preserve vNum(i)

vNum(i) = Mid(CL.Value, i, 1)

Next i

trasferisco gli item della precedente matrice in una altra matrice di appoggio inserendo il punto
Codice: Seleziona tutto
 For pos = 1 To UBound(vNum) - 3         
           ReDim Preserve arr3(pos)
           
           arr3(pos) = vNum(pos) & "." & vNum(pos + 1) & vNum(pos + 2) & vNum(pos + 3) <<<<<
           
         .Cells(pos + 20, 2).Value = arr3(pos)
         
         Next

questo funziona per numeri del tipo 1234, ma non per altri;
non riesco a far variare il numero 3 in UBound(vNum) - 3 ed a cambiare la posizione del punto
in quanto se ho il numero 12345 la linea evidenziata fornisce 1.234
forse un altro modo di procedere sarebbe più spedito e semplice.
ciao grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Sponsor
 

Re: INSERIRE PUNTO IN NUMERO

Postdi Anthony47 » 16/02/19 00:43

Partecipero' alla festa se mi dici il motivo per cui devi formattare la cella come Testo per poi inserirgli un numero; mentre puoi formattarla Numero e ottenere gratuitamente quello che stai cercando di fare con le macro.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: INSERIRE PUNTO IN NUMERO

Postdi miko » 23/02/19 08:36

Salve,
Parteciperò alla festa se mi dici ........

il motivo è legato all'altro mio topic "INSERIRE SOLO NUMERI POSITIVI IN CELLA FORMATO TESTO"
leggasi mio ultimo post;
trattando numeri con cifre maggiori di 15, faccio confusione, al momento
della digitazione, nell'inserire il punto e perciò ho pensato di lasciare al vba, più preciso di me,
il compito dell'inserimento del punto.
ciao, grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: INSERIRE PUNTO IN NUMERO

Postdi Marius44 » 23/02/19 16:48

Ciao
Prova questa macro con l'Evento Worksheet_BeforeDoubleClick e relativo all'intervallo A1:B5 formattate come testo.
Codice: Seleziona tutto
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1:B5")) Is Nothing Then
  aa = Target.Value
  n = Len(aa)
  On Error Resume Next
  virg = InStr(aa, ",")
  On Error GoTo 0
  If IsEmpty(virg) Then
    aa = aa & ","
    n = n + 1
    aa = Left(aa, virg - 1)
  End If
  num = Right(aa, n - virg + 1)
  For i = virg - 1 To 1 Step -1
    a = a + 1
    If a <= 3 Then
      If Mid(aa, i, 1) = "," Then a = 0
      num = Mid(aa, i, 1) & num
    ElseIf a > 3 Then
      num = "." & num
      i = i + 1
      a = 0
    End If
  Next i
End If
Cells(Target.Row, Target.Column + 1) = num
End Sub

Credo che faccia quello che chiedi. Ovviamente se ti va bene occorre premettere Option Explicit e la conseguente dichiarazione delle variabili.
Fai sapere. Ciao,
Mario
Marius44
Utente Senior
 
Post: 655
Iscritto il: 07/09/15 22:00

Re: INSERIRE PUNTO IN NUMERO

Postdi Anthony47 » 23/02/19 20:35

Non perdere la proposta di Marius, prima di questo messaggio.

Il mio commento e' che se poni due pezzi dello stesso problema in due discussioni diverse allora crei le condizioni per non far capire la domanda e non avere risposte immediatamente utilizzabili (faccio riferimento a quanto si discute qui: viewtopic.php?f=26&t=110368)

Sovrapponendo le tue due discussioni io deduco le seguenti esigenze:
-fare in modo che in una cella venga inserita una stringa che simuli un numero, controllando che usi solo caratteri numerici, che non ci sia il segno "meno", che siano max 25 crt, che ci siano 0-1-2 decimali
-inserire in questa stringa eventuali "punti" da usare come separatori delle migliaia

Non e' chiaro se vuoi essere "repressivo" (cioe' eventuali discrepanze portano al messaggio "Ahi ahi, hai sbagliato; ritenta") o "propositivo" (cioe' gestire eventuali discrepanze; es i decimali oltre 2 vengono tagliati, eventuali caratteri non numerici vengono ignorati).

Volendo essere propositivo, io suggerisco quest'altro approccio, che e' basato sull'uso di un TextBox:
-fai una prova su un nuovo foglio di lavoro, e inseriscici un TextBox prelevandolo dal gruppo Controlli Activex; dimensionalo che sia in grado di ospitare la stringa max che hai in mente. Chiamalo TextBox1
-sul modulo di codice di questo foglio di lavoro, che assumo sia pulito (nessuna macro), inserisci questo insieme di codici:

Codice: Seleziona tutto
Dim StopEv As Boolean, oCont

Private Sub TextBox1_Change()
Dim vPos As Long, nwTxt As String, maxLen As Long
If StopEv Then Exit Sub
'
maxLen = 25         '<<< Max numero di digit
'
StopEv = True
nwTxt = NumOnlyTx(TextBox1.Text)
vPos = InStr(1, nwTxt, ",", vbTextCompare)
If vPos > 0 And (Len(nwTxt) - vPos) >= 3 Then
    nwTxt = Left(nwTxt, vPos + 2)
End If
If (vPos - 1) > maxLen Or Len(nwTxt) - vPos > maxLen Then
    TextBox1.BackColor = RGB(255, 100, 100)
Else
    TextBox1.BackColor = RGB(255, 255, 255)
End If
TextBox1.Text = nwTxt
StopEv = False
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim cTxt As String, nTxt As String, I As Long, dPos As Long, DecCnt As Long
'
If KeyCode = 27 Or (KeyCode > 36 And KeyCode < 41) Then
    On Error Resume Next
        Range(TextBox1.LinkedCell) = "'" & oCont
        TextBox1.Visible = False
        If KeyCode = 38 Then voff = -1
        If KeyCode = 40 Then voff = 1
        If KeyCode = 37 Then hoff = -1
        If KeyCode = 39 Then hoff = 1
        Range(TextBox1.LinkedCell).Offset(voff, hoff).Activate
    On Error GoTo 0
End If

If (KeyCode = 13 Or KeyCode = 9) And TextBox1.BackColor = RGB(255, 255, 255) Then
    cTxt = TextBox1.Text
    dPos = InStr(1, cTxt, ",", vbTextCompare)
    If dPos = 0 Then
        dPos = Len(cTxt)
    Else
        nTxt = "," & Right(cTxt, Len(cTxt) - dPos)
        If nTxt = "," Then nTxt = ",00": corri = 2
    End If
    For I = Len(cTxt) - Len(nTxt) + corri To 1 Step -1
        If DecCnt > 0 And DecCnt Mod 3 = 0 Then nTxt = "." & nTxt
        nTxt = Mid(cTxt, I, 1) & nTxt
        DecCnt = DecCnt + 1
    Next I
    On Error Resume Next
        Range(TextBox1.LinkedCell) = "'" & nTxt
        TextBox1.Visible = False
        Range(TextBox1.LinkedCell).Offset(1, 0).Activate
    On Error GoTo 0
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myArea As String
If Target.Count > 1 Then Exit Sub
myArea = "B2:B10"     '<<< L'area di applicazione
If Not Application.Intersect(Target, Range(myArea)) Is Nothing Then
    oCont = Target.Value
    Me.TextBox1.Top = Target.Cells(1, 1).Top
    Me.TextBox1.Left = Target.Cells(1, 2).Left
    Me.TextBox1.LinkedCell = Target.Cells(1, 1).Address
    Me.TextBox1.Visible = True
    Me.TextBox1.Text = Target.Value
    Me.TextBox1.Activate
    Me.TextBox1.SelStart = 0
    Me.TextBox1.SelLength = Len(Me.TextBox1.Text)
Else
    Me.TextBox1.Visible = False
End If
End Sub


Function NumOnlyTx(txt As String) As Variant
If Len(txt) > 0 Then
    With CreateObject("VBScript.RegExp")
        .Pattern = "[^0123456789,]"       '
        .Global = True
        NumOnlyTx = (.Replace(txt, ""))
    End With
Else
    NumOnlyTx = ""
End If
End Function

Ora val sul foglio di lavoro, esci dalla modalita' Progettazione e seleziona la cella B2

Il textbox verra' posizionato accanto a B2 e puoi scriverci; il textbox accettera' solo caratteri numerici e virgola; in caso di virgola il textbox limita a 2 decimali; in ogni caso la parte numerica prima dell'eventuale virgola non potra' contenere piu' di 25 caratteri. Se oltre 25 crt allora il textbox si colora di rosso.

Tramite il tasto Enter oppure Tab in avanti, e se il textbox non e' Rosso, il contenuto del textbox verra' inserito nella cella previo l'inserimento dei separatori delle migliaia, e la cella successiva verso il basso viene selezionata.

L'eventuale uso del tasto Esc, oppure delle frecce di spostamento, fa abortire l'inserimento tramite textbox con "probabile" ripristino del valore inziale; inoltre le frecce provocano il conseguente spostamento della selezione.

Noterai nel codice della Worksheet_SelectionChange una istruzione marcata <<<, che identifica quale area del foglio attivera' la gestione di questo textbox e della sua logica (ora e' impostata su B2:B10).
Nella TextBox1_Change invece e' possibile dichiarare il numero max di digit per la parte intera del textbox (ora impostata su 25)
Modifica queste istruzioni come serve a te.

Nella mia intenzione questa e' la risposta ad ambedue le richieste, che ho trattato integrandole e non separatamente.

Vedi se trovi qualche spunto interessante...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: INSERIRE PUNTO IN NUMERO

Postdi miko » 21/03/19 08:23

Buongiorno,
Perdonate il mio ritardo, ma molti impegni e poco tempo libero.
Molti giorni addietro avevo visto le vostre risposte, ma non ho avuto il tempo di testare con accuratezza i codici da voi realizzati.
Ricordo che velocemente ho inserito il codice di Marius, anche nell' evento Change, e funziona;
notavo la presenza della virgola come elemento di riferimento per l'inserimento della punteggiatura;
questo è un "inconveniente" nel caso di numeri interi, ma il problema si risolve inserendo 2 numeri decimali nulli.
per quanto riguarda la risposta di Anthony, ad oggi non ho avuto il tempo di testare il suo codice;
appena ho più tempo riferirò in merito, anche per dissolvere le incertezze evidenziate nella sua risposta.
intanto vi saluto e ringrazio per il vostro contributo.
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44


Torna a Applicazioni Office Windows


Topic correlati a "INSERIRE PUNTO IN NUMERO":


Chi c’è in linea

Visitano il forum: Nessuno e 104 ospiti