Novità

come trasformare in numeri romani alcuni numeri arabi di una sotto stringa... ?

lotto_tom75

Advanced Premium Member
ho provato così grazie al suggerimento e code AI ...

Codice:
Function AraboInRomano(numero)
    Dim M = Array("", "M", "MM", "MMM")
    Dim C = Array("", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM")
    Dim X = Array("", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC")
    Dim I = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
    Dim migliaia, centinaia, decine, unita
    migliaia = Int(numero / 1000)
    centinaia = Int((numero Mod 1000) / 100)
    decine = Int((numero Mod 100) / 10)
    unita = numero Mod 10
    AraboInRomano = M(migliaia) & C(centinaia) & X(decine) & I(unita)
End Function

Sub Main

Dim s 'As String
s = "05.30 r: BA p: 1.2.3.4.5 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?"
Dim start 'As Integer
start = InStr(s, "p:") + 2
Dim finish 'As Integer
finish = InStr(s, "rap")
Dim substring 'As String
substring = Mid(s, start, finish - start)
Dim numbers '() 'As String
numbers = Split(substring, ".")
Dim result 'As String
result = ""
For Each number In numbers
    result = result & AraboInRomano(CInt(number)) & "."
Next
result = Left(result, Len(result) - 1) ' Rimuove l'ultimo punto
s = Replace(s, substring, result)


End Sub

ma mi da errore... 🫠
 

lotto_tom75

Advanced Premium Member
05.30 r: BA p:I.II.III.IV.Vrap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?

è corretto?

si lottoluke quello sarebbe l'output che vorrei avere trasformato in automatico. In sostanza solo la sottostringa da p: a rap (esclusi) dovrebbe cambiare i numeri arabi dinamici da 1 a 5 nei rispettivi numeri romani... I numeri da cambiare possono essere in quantità variabile da 1 a 5 ossia posso avere sotto stringhe tipo : p: 1 rap= oppure p: 1.3 rap= oppure p: 1.3.5 rap= ecc... 👋
 

lottoLuke

Banned
Function AraboInRomano(numero As Integer) As String
Dim valori(3 To 0, 9 To 0) As String
valori(0, 1) = "I": valori(0, 2) = "II": valori(0, 3) = "III": valori(0, 4) = "IV": valori(0, 5) = "V"
valori(0, 6) = "VI": valori(0, 7) = "VII": valori(0, 8) = "VIII": valori(0, 9) = "IX"
valori(1, 1) = "X": valori(1, 2) = "XX": valori(1, 3) = "XXX": valori(1, 4) = "XL": valori(1, 5) = "L"
valori(1, 6) = "LX": valori(1, 7) = "LXX": valori(1, 8) = "LXXX": valori(1, 9) = "XC"
valori(2, 1) = "C": valori(2, 2) = "CC": valori(2, 3) = "CCC": valori(2, 4) = "CD": valori(2, 5) = "D"
valori(2, 6) = "DC": valori(2, 7) = "DCC": valori(2, 8) = "DCCC": valori(2, 9) = "CM"
valori(3, 1) = "M": valori(3, 2) = "MM": valori(3, 3) = "MMM"

Dim migliaia As Integer, centinaia As Integer, decine As Integer, unita As Integer
migliaia = numero \ 1000
centinaia = (numero Mod 1000) \ 100
decine = (numero Mod 100) \ 10
unita = numero Mod 10

AraboInRomano = valori(3, migliaia) & valori(2, centinaia) & valori(1, decine) & valori(0, unita)
End Function

Sub ConvertiNumeriRomani()
Dim testoInput As String
testoInput = "05.30 r: BA p: 1.2.3.4.5 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?"

Dim inizio As Integer, fine As Integer
inizio = InStr(testoInput, "p:") + 2
fine = InStr(testoInput, "rap")

Dim sottostringa As String
sottostringa = Mid(testoInput, inizio, fine - inizio)

Dim numeriArabi() As String
numeriArabi = Split(sottostringa, ".")

Dim risultato As String
risultato = ""

Dim numero As String
For Each numero In numeriArabi
risultato = risultato & AraboInRomano(CInt(numero)) & "."
Next numero

risultato = Left(risultato, Len(risultato) - 1) ' Rimuove l'ultimo punto
testoInput = Replace(testoInput, sottostringa, risultato)

MsgBox testoInput ' Stampa il risultato
End Sub


forse ... si spera
:Questo codice VBA è equivalente al codice che hai fornito inizialmente in Python, ma adattato per essere eseguito in un ambiente VBA. La funzione AraboInRomano converte i numeri arabi in numeri romani, mentre la subroutine ConvertiNumeriRomani utilizza questa funzione per convertire i numeri presenti nella sottostringa e visualizza il risultato con una finestra di messaggio (MsgBox).
 

lottoLuke

Banned
oppure cattura solo tra "p" e "rap"

Function AraboInRomano(numero As Integer) As String
Dim valori(3 To 0, 9 To 0) As String
valori(0, 1) = "I": valori(0, 2) = "II": valori(0, 3) = "III": valori(0, 4) = "IV": valori(0, 5) = "V"
valori(0, 6) = "VI": valori(0, 7) = "VII": valori(0, 8) = "VIII": valori(0, 9) = "IX"
valori(1, 1) = "X": valori(1, 2) = "XX": valori(1, 3) = "XXX": valori(1, 4) = "XL": valori(1, 5) = "L"
valori(1, 6) = "LX": valori(1, 7) = "LXX": valori(1, 8) = "LXXX": valori(1, 9) = "XC"
valori(2, 1) = "C": valori(2, 2) = "CC": valori(2, 3) = "CCC": valori(2, 4) = "CD": valori(2, 5) = "D"
valori(2, 6) = "DC": valori(2, 7) = "DCC": valori(2, 8) = "DCCC": valori(2, 9) = "CM"
valori(3, 1) = "M": valori(3, 2) = "MM": valori(3, 3) = "MMM"

Dim migliaia As Integer, centinaia As Integer, decine As Integer, unita As Integer
migliaia = numero \ 1000
centinaia = (numero Mod 1000) \ 100
decine = (numero Mod 100) \ 10
unita = numero Mod 10

AraboInRomano = valori(3, migliaia) & valori(2, centinaia) & valori(1, decine) & valori(0, unita)
End Function

Sub ConvertiNumeriRomani()
Dim testoInput As String
testoInput = "05.30 r: BA p: 1.2.3.4.5 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?"

Dim inizio As Integer, fine As Integer
inizio = InStr(testoInput, "p:") + 2
fine = InStr(testoInput, "rap")

Dim sottostringa As String
sottostringa = Mid(testoInput, inizio, fine - inizio)

Dim numeriArabi() As String
numeriArabi = Split(sottostringa, ".")

Dim risultato As String
risultato = ""

Dim numero As String
For Each numero In numeriArabi
If IsNumeric(numero) Then
risultato = risultato & AraboInRomano(CInt(numero)) & "."
Else
risultato = risultato & numero & "."
End If
Next numero

risultato = Left(risultato, Len(risultato) - 1) ' Rimuove l'ultimo punto

MsgBox risultato ' Stampa il risultato
End Sub


speriamo altrimenti lucy fa brutta figura:LOL:
 

lotto_tom75

Advanced Premium Member
grazie lottoluke ma da errore anche il tuo codice. Mi servirebbe in linguaggio "spaziometria" non in vbs o vba.
 

lottoLuke

Banned
nel caso servisse: in python genera html conferma risultato.

def converti_numeri_romani(testo):
# Trova l'indice di inizio della parte interessante della stringa
inizio = testo.find("05.30 r: BA p: ") + len("05.30 r: BA p: ")

# Trova l'indice di fine della parte interessante della stringa
fine = testo.find("rap 1.2.3.4 num.")

# Verifica se gli indici sono validi
if inizio < 0 or fine < 0:
print("Formato della stringa non valido.")
return

# Estrai la sottostringa compresa tra gli indici di inizio e fine
sottostringa = testo[inizio: fine].strip()

# Verifica se "1.2.3.4.5" è presente nella sottostringa
if "1.2.3.4.5" in sottostringa:
# Creazione del risultato HTML
risultato_html = f"<html><body><p>Risultato: 1.2.3.4.5</p></body></html>"

# Scrittura del risultato in un file HTML
with open("risultato.html", "w") as file:
file.write(risultato_html)
print("La sequenza è stata trovata e il risultato è stato scritto in risultato.html.")
else:
print("Sequenza non trovata nella sottostringa.")

# Esempio di utilizzo
testo_input = "05.30 r: BA p: 1.2.3.4.5 rap 1.2.3.4 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?"
converti_numeri_romani(testo_input)
 

lotto_tom75

Advanced Premium Member
di nuovo grazie lottoluke ma... a me in questo frangente servirebbe avere la funzione solo per applicarla all'interno di script di spaziometria.
 

lottoLuke

Banned
vediamo @lotto_tom75 mi incuriosisce e non poco non tanto per l'esito in quanto per la sfida agli errori con la Lucy è una battibeccaia che te lo dico io ;) (con spaziometria)

Dim M, C, X, I

Function AraboInRomano(numero)
Dim migliaia, centinaia, decine, unita
migliaia = Int(numero / 1000)
centinaia = Int((numero Mod 1000) / 100)
decine = Int((numero Mod 100) / 10)
unita = numero Mod 10
AraboInRomano = M(migliaia) & C(centinaia) & X(decine) & I(unita)
End Function

Sub Main
M = Array("", "M", "MM", "MMM")
C = Array("", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM")
X = Array("", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC")
I = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")

Dim s
s = "05.30 r: BA p: 1.2.3.4.5 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?"

' Trova l'indice di inizio della parte compresa tra "p:" e "rap"
Dim start
start = InStr(s, "p:") + 3 ' Aggiungiamo 3 per saltare lo spazio dopo "p:"

' Trova l'indice di fine della parte compresa tra "p:" e "rap"
Dim finish
finish = InStr(start, s, "rap") - 1 ' Sottraiamo 1 per non includere lo spazio prima di "rap"

' Estrai la parte compresa tra "p:" e "rap"
Dim substring
substring = Mid(s, start, finish - start)

' Visualizza la sottostringa estratta
MsgBox "Sottostringa estratta: " & substring

' Cattura il risultato come "esito"
Dim esito
esito = substring

' Esegui la conversione dei numeri e sostituisci nella stringa originale
Dim numbers
numbers = Split(substring, ".")
Dim result
result = ""
For Each number In numbers
result = result & AraboInRomano(CInt(number)) & "."
Next
result = Left(result, Len(result) - 1) ' Rimuove l'ultimo punto

' Scrivi il risultato su un file di testo
Dim fso, outFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set outFile = fso.CreateTextFile("risultato.txt", True)
outFile.WriteLine result
outFile.Close

MsgBox "Il risultato è stato scritto nel file 'risultato.txt'"
End Sub
 

lotto_tom75

Advanced Premium Member
vediamo @lotto_tom75 mi incuriosisce e non poco non tanto per l'esito in quanto per la sfida agli errori con la Lucy è una battibeccaia che te lo dico io ;) (con spaziometria)

Dim M, C, X, I

Function AraboInRomano(numero)
Dim migliaia, centinaia, decine, unita
migliaia = Int(numero / 1000)
centinaia = Int((numero Mod 1000) / 100)
decine = Int((numero Mod 100) / 10)
unita = numero Mod 10
AraboInRomano = M(migliaia) & C(centinaia) & X(decine) & I(unita)
End Function

Sub Main
M = Array("", "M", "MM", "MMM")
C = Array("", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM")
X = Array("", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC")
I = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")

Dim s
s = "05.30 r: BA p: 1.2.3.4.5 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?"

' Trova l'indice di inizio della parte compresa tra "p:" e "rap"
Dim start
start = InStr(s, "p:") + 3 ' Aggiungiamo 3 per saltare lo spazio dopo "p:"

' Trova l'indice di fine della parte compresa tra "p:" e "rap"
Dim finish
finish = InStr(start, s, "rap") - 1 ' Sottraiamo 1 per non includere lo spazio prima di "rap"

' Estrai la parte compresa tra "p:" e "rap"
Dim substring
substring = Mid(s, start, finish - start)

' Visualizza la sottostringa estratta
MsgBox "Sottostringa estratta: " & substring

' Cattura il risultato come "esito"
Dim esito
esito = substring

' Esegui la conversione dei numeri e sostituisci nella stringa originale
Dim numbers
numbers = Split(substring, ".")
Dim result
result = ""
For Each number In numbers
result = result & AraboInRomano(CInt(number)) & "."
Next
result = Left(result, Len(result) - 1) ' Rimuove l'ultimo punto

' Scrivi il risultato su un file di testo
Dim fso, outFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set outFile = fso.CreateTextFile("risultato.txt", True)
outFile.WriteLine result
outFile.Close

MsgBox "Il risultato è stato scritto nel file 'risultato.txt'"
End Sub

caspiterina friend! forse ci siamo quasi! :eek:😀 Tu con la tua Lucy riesci a comunicare molto meglio di quanto faccio io con la mia AI ! Complimenti! Come hai fatto a farle imparare il linguaggio di spaziometria? 🤪 Ad ogni modo bisognerebbe che la funzione mi ripresentasse la stessa stringa trasformata solo nella sua sotto stringa dei numeri in oggetto. In altre parole dovrei avere per ogni risultato processato qualcosa di questo tipo:

es. del tutto fittizi...
05.30 r: BA p: I.II.III.IV.V rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2
01.02.03 r: BA p: I.II.III rap=rsp 243 num. inc 4 incmax att=sto 89 fqp 42 s 2
88 r: BA p: IV.V rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2

mentre adesso sembra solo... estrapolarmi e trasformarmi correttamente in romani i numeri arabi nella sottostringa... :)
 

lottoLuke

Banned
@lotto_tom75 ottengo questo ora
05.30 r: BA p: I.II.III.IV.V rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?
05.30 r: BA p: I.II.III rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?
05.30 r: BA p: IV.V rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?

:unsure:
 

lottoLuke

Banned
Dim M, C, X, I ' Definisci le variabili come variabili globali al di fuori della funzione

Function AraboInRomano(numero)
M = Array("", "M", "MM", "MMM")
C = Array("", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM")
X = Array("", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC")
I = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")

Dim migliaia, centinaia, decine, unita
migliaia = Int(numero / 1000)
centinaia = Int((numero Mod 1000) / 100)
decine = Int((numero Mod 100) / 10)
unita = numero Mod 10
AraboInRomano = M(migliaia) & C(centinaia) & X(decine) & I(unita)
End Function

Sub Main
' Definisci la stringa originale
Dim originalString
originalString = "05.30 r: BA p: 1.2.3.4.5 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?" & vbCrLf & _
"05.30 r: BA p: 1.2.3 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?" & vbCrLf & _
"05.30 r: BA p: 4.5 rap=rsp 243 num. inc 4 incmax att=sto 87 fqp 42 s 2; ?"

' Dividi la stringa originale in righe
Dim lines
lines = Split(originalString, vbCrLf)

' Verifica se l'array "lines" è stato correttamente inizializzato
If IsArray(lines) Then
' Apri il file risultato.txt
Dim fso, outFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set outFile = fso.CreateTextFile("risultato.txt", True)

' Processa ciascuna riga
Dim i
For i = LBound(lines) To UBound(lines)
' Estrai la parte compresa tra "p:" e "rap"
Dim start
start = InStr(lines(i), "p:") + 3
Dim finish
finish = InStr(start, lines(i), "rap") - 1
Dim substring
substring = Mid(lines(I), start, finish - start)

' Esegui la conversione dei numeri
Dim numbers
numbers = Split(substring, ".")
Dim result
result = ""
Dim j
For j = LBound(numbers) To UBound(numbers)
result = result & AraboInRomano(CInt(numbers(j))) & "."
Next
result = Left(result, Len(result) - 1) ' Rimuove l'ultimo punto

' Sostituisci i numeri romani nella stringa originale
lines(I) = Replace(lines(I), substring, result)

' Scrivi la riga con il risultato nel file risultato.txt
outFile.WriteLine lines(I)
Next

' Chiudi il file risultato.txt
outFile.Close

MsgBox "Il risultato è stato scritto nel file 'risultato.txt'"
Else
MsgBox "Errore: Impossibile suddividere la stringa in righe."
End If
End Sub

Main
 

i legend

Premium Member
Ciao a tutti e complimenti per la routine.
Domanda, ma a te serviva scrivere solo le posizioni ( da 1 a 5 )in numero romano oppure arrivare a scrivere per esempio: 11502 ? Quindi anche le migliaia ?
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 09 maggio 2024
    Bari
    85
    27
    28
    56
    83
    Cagliari
    29
    34
    75
    82
    18
    Firenze
    16
    74
    36
    55
    64
    Genova
    77
    57
    29
    34
    05
    Milano
    69
    33
    28
    18
    21
    Napoli
    69
    10
    03
    05
    12
    Palermo
    06
    34
    69
    38
    13
    Roma
    35
    86
    69
    16
    06
    Torino
    08
    56
    04
    26
    23
    Venezia
    27
    84
    28
    13
    68
    Nazionale
    68
    21
    64
    11
    07
    Estrazione Simbolotto
    Milano
    40
    18
    20
    15
    37

Ultimi Messaggi

Alto