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
    sabato 27 aprile 2024
    Bari
    02
    74
    34
    72
    78
    Cagliari
    60
    62
    43
    58
    38
    Firenze
    88
    70
    85
    38
    50
    Genova
    18
    61
    70
    08
    80
    Milano
    85
    81
    16
    03
    26
    Napoli
    34
    31
    01
    41
    51
    Palermo
    52
    59
    54
    35
    05
    Roma
    34
    83
    23
    67
    61
    Torino
    86
    59
    61
    62
    48
    Venezia
    69
    50
    40
    05
    79
    Nazionale
    31
    30
    85
    45
    67
    Estrazione Simbolotto
    Genova
    37
    02
    21
    34
    13
Alto