Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim uc As Integer If Not Intersect(Target, Range("B:B")) Is Nothing Then Range(Cells(Target.Row, "C"), Cells(Target.Row, "K")).ClearContents For i = 1 To Len(Target.Value) uc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column If Mid(Target.Value, i, 1) <> "/" Then Cells(Target.Row, uc + 1).Value = UCase(Mid(Target.Value, i, 1)) End If Next i End If End Sub
alfrimpa, 17/03/2021 15:58:Inserisci questo codice nel modulo del foglio1 vbPrivate Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim uc As Integer If Not Intersect(Target, Range("B:B")) Is Nothing Then Range(Cells(Target.Row, "C"), Cells(Target.Row, "K")).ClearContents For i = 1 To Len(Target.Value) uc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column If Mid(Target.Value, i, 1) <> "/" Then Cells(Target.Row, uc + 1).Value = UCase(Mid(Target.Value, i, 1)) End If Next i End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim uc As Integer Dim str As String On Error GoTo Errore If Not Intersect(Target, Range("B:B")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, "c"), Cells(Target.Row, "Z")).ClearContents str = Target.Value Target.Value = UCase(Left(Target.Value, 1)) For i = 2 To Len(str) uc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column If Mid(str, i, 1) <> "/" Then Cells(Target.Row, uc + 1).Value = UCase(Mid(str, i, 1)) End If Next i End If Application.EnableEvents = True Errore: Application.EnableEvents = True End Sub
alfrimpa, 17/03/2021 17:44:Se ho capito prova con questa vbPrivate Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim uc As Integer Dim str As String On Error GoTo Errore If Not Intersect(Target, Range("B:B")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, "c"), Cells(Target.Row, "K")).ClearContents str = Target.Value Target.Value = UCase(Left(Target.Value, 1)) For i = 2 To Len(str) uc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column If Mid(str, i, 1) <> "/" Then Cells(Target.Row, uc + 1).Value = UCase(Mid(str, i, 1)) End If Next i End If Application.EnableEvents = True Errore: Application.EnableEvents = True End Sub La cella B4 deve essere formattata Generale
Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim uc As Integer Dim str As String On Error GoTo Errore If Not Intersect(Target, Range("B:B")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, "c"), Cells(Target.Row, "K")).ClearContents str = Target.Value Target.Value = UCase(Left(Target.Value, 1)) For i = 2 To Len(str) uc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column If Mid(str, i, 1) <> "/" Then Cells(Target.Row, uc + 1).Value = UCase(Mid(str, i, 1)) End If Next i End If Application.EnableEvents = True Errore: Application.EnableEvents = True End Sub
alfrimpa, 17/03/2021 18:24:Ma la macro l'hai provata?
alfrimpa, 17/03/2021 18:35:Fai una ricerca con Google e troverai milioni di link che ti dicono come salvare un file con le macro. Siamo a meno dell'ABC di Excel.
mapero, 17/03/2021 18:39: purtroppo siamo ai numeri negativi nel mio caso
alfrimpa, 17/03/2021 18:51:E infatti l'ultimo file allegato, per come ho capito, funziona. Cosa non ti torna?
alfrimpa, 17/03/2021 19:11:Riallego il file
mapero, 17/03/2021 19:13: così funge per me un mistero grazie mille Alfredo, soprattutto per la comprensione