La macro l'ho creata e la posto qui ma allego anche il file in quanto devi posizionare la cartella Poker nell'archivio in C:\ in maniera da avere, almeno all'inizio, il percorso C:\Poker\Poker.txt (poi semmai lo cambi all'interno della macro)
- Codice: Seleziona tutto
Sub Caricamento()
Dim vettore(54) As String
Dim tabella(30, 3)
tabella(1, 1) = 1: tabella(1, 2) = 20: tabella(1, 3) = 9 '<Torneo
tabella(2, 1) = 2: tabella(2, 2) = 10: tabella(2, 3) = 4 '<Buy
tabella(3, 1) = 3: tabella(3, 2) = 1: tabella(3, 3) = 1 '<giocatori
tabella(4, 1) = 4: tabella(4, 2) = 1: tabella(4, 3) = 1 '<<< non usata
tabella(5, 1) = 5: tabella(5, 2) = 17: tabella(5, 3) = 10 '<Data
tabella(17, 1) = 17: tabella(17, 2) = 20: tabella(17, 3) = 1 '<Classifica
tabella(18, 1) = 18: tabella(18, 2) = 1: tabella(18, 3) = 1 '<<< vuota
tabella(19, 1) = 19: tabella(19, 2) = 1: tabella(19, 3) = 2 '<Mani
tabella(20, 1) = 20: tabella(20, 2) = 1: tabella(20, 3) = 50 '<Small
tabella(21, 1) = 21: tabella(21, 2) = 1: tabella(21, 3) = 50 '<Big
tabella(22, 1) = 22: tabella(22, 2) = 1: tabella(22, 3) = 50 '<Altro
tabella(23, 1) = 23: tabella(23, 2) = 1: tabella(23, 3) = 1 '<<< non usata
tabella(24, 1) = 24: tabella(24, 2) = 20: tabella(24, 3) = 9 '<<< vuota
tabella(25, 1) = 25: tabella(25, 2) = 30: tabella(25, 3) = 1 '<<< non usata
tabella(26, 1) = 26: tabella(26, 2) = 31: tabella(26, 3) = 1 '<<Piatti SD
Open "C:\Poker\Poker.txt" For Input As #1 '<<< PERCORSO FILE TXT
x = 0
Y = 0
Do Until EOF(1)
Line Input #1, riga
If Mid(riga, 1, 5) = "Poker" And Y <> 0 Then
Worksheets("Tornei").Select
UR = Worksheets("Tornei").Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & UR).Value = vettore(1)
Range("B" & UR).Value = BuyIn
Range("C" & UR).Value = vettore(3)
Range("D" & UR).Value = vettore(5)
Range("E" & UR).Value = vettore(17)
Range("F" & UR).FormulaR1C1 = "=IF(RC[-1]=1,(RC[-4]*RC[-3]-0.5*RC[-3])/2,IF(RC[-1]=2,(RC[-4]*RC[-3]-0.5*RC[-3])/2*0.6,IF(RC[-1]=3,(RC[-4]*RC[-3]-0.5*RC[-3])/2*0.4,"""")))"
Range("G" & UR).Value = vettore(19)
Range("H" & UR).Value = vettore(20)
Range("I" & UR).Value = vettore(21)
Range("J" & UR).Value = vettore(22)
Range("K" & UR).Value = vettore(26)
Range("L" & UR).Value = Elimin
x = 0
End If
x = x + 1
If (x > 5 And x < 17) Or (x > 22 And x < 26) Then GoTo saltaR
If x = 27 Then
Y = 1
x = x + 1
GoTo saltaR
End If
vettore(x) = Mid(riga, tabella(x, 2), tabella(x, 3))
If x = 2 Then
QuotaPart = Mid(riga, 16, 4)
BuyIn = Val(vettore(x)) + Val(QuotaPart)
End If
If x = 17 Then Elimin = Mid(riga, 51, 10)
If x > 19 And x < 23 Then
vettore(x) = Mid(vettore(x), InStrRev(vettore(x), "(") + 1, InStrRev(vettore(x), "%") - InStrRev(vettore(x), "(") - 1)
End If
saltaR:
Loop
Close #1
Worksheets("Tornei").Select
UR = Worksheets("Tornei").Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & UR).Value = vettore(1)
Range("B" & UR).Value = BuyIn
Range("C" & UR).Value = vettore(3)
Range("D" & UR).Value = vettore(5)
Range("E" & UR).Value = vettore(17)
Range("F" & UR).FormulaR1C1 = "=IF(RC[-1]=1,(RC[-4]*RC[-3]-0.5*RC[-3])/2,IF(RC[-1]=2,(RC[-4]*RC[-3]-0.5*RC[-3])/2*0.6,IF(RC[-1]=3,(RC[-4]*RC[-3]-0.5*RC[-3])/2*0.4,"""")))"
Range("G" & UR).Value = vettore(19)
Range("H" & UR).Value = vettore(20)
Range("I" & UR).Value = vettore(21)
Range("J" & UR).Value = vettore(22)
Range("K" & UR).Value = vettore(26)
Range("L" & UR).Value = Elimin
DataF = Mid(vettore(5), 7, 4) & Mid(vettore(5), 4, 2) & Mid(vettore(5), 1, 2)
inpfile = "C:\Poker\Poker.txt"
outfile = "C:\Poker\" & DataF & "_Poker.txt"
On Error Resume Next
FileCopy inpfile, outfile
On Error GoTo 0
End Sub
Vedi se va bene e fai sapere
Ciao