Ciao,
aggiorno la macro con degli accorgimenti che rendono il risultato ancora più preciso.
addirittura si riesce a mantenere il ciclo e i conteggi, senza pendere contromisure, fino alla
quarta colonna.
Rimango dell'opinione che si debba però gestire l'indentatura controllando le differenti lunghezze associate ai tabs e poi importare con un semplice delimitatore a lunghezze fisse.
- Codice: Seleziona tutto
Public MR As String, col As Long, campo As String, LC As Integer
Sub ImportaTesto()
Cells.Clear
Perc = ThisWorkbook.Path & "\"
Open Perc & "elenco_cli_ind_destinazione.txt" For Input As #1
Do Until EOF(1)
Line Input #1, Riga
col = 0
MR = Riga
If Mid(MR, 1, 1) <> "=" Then
UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row + 1
LC = 11
Call Riempi_campo
Range("A" & UR).Value = Trim(campo)
LC = 40
Call Riempi_campo
Range("B" & UR).Value = Trim(campo)
LC = 40
Call Riempi_campo
Range("C" & UR).Value = Trim(campo)
LC = 40
Call Riempi_campo
Range("D" & UR).Value = Trim(campo)
LC = 16
Call Riempi_campo2
Range("E" & UR).NumberFormat = "@"
Range("E" & UR).Value = Right(Trim(campo), 9)
Dim pippo1 As String
Dim pippo2 As String
Dim pippo3 As Integer
pippo3 = Len(Range("E" & UR).Value)
pippo1 = Left(Range("E" & UR).Value, 2)
pippo2 = Right(Range("D" & UR), 2)
If pippo1 = pippo2 And pippo3 > 5 Then
Dim Lenghtval As Integer
If Range("E" & UR).Value <> 0 Then
Lenghtval = Len(Range("E" & UR).Value) - 2
Range("E" & UR).Value = Right(Range("E" & UR), Lenghtval)
End If
pippo3 = 0
End If
pippo1 = Left(Range("E" & UR).Value, 1)
pippo2 = Right(Range("D" & UR), 1)
If pippo1 = pippo2 And pippo3 > 5 Then
If Range("E" & UR).Value <> 0 Then
Lenghtval = Len(Range("E" & UR).Value) - 1
Range("E" & UR).Value = Right(Range("E" & UR), Lenghtval)
End If
pippo3 = 0
End If
LC = 40
Call Riempi_campo2
Range("F" & UR).Value = Trim(campo)
LC = 13
Call Riempi_campo3
Range("G" & UR).Value = Trim(campo)
LC = 14
Call Riempi_campo3
Range("H" & UR).Value = Trim(campo)
End If
Loop
Close #1
End Sub
Private Sub Riempi_campo()
Dim a As Integer
Dim b As Integer
a = 0
b = 0
Virg = " "
campo = ""
For Car = 0 To LC
col = col + 1
Virg = Mid(MR, col, 1)
If Virg = Chr(32) And col > 12 And Trim(campo) = "" Then
a = a + 1
End If
If Virg = Chr(9) Then
Car = Car + 8
Else
campo = campo & Mid(MR, col, 1)
End If
Next Car
If Trim(campo) <> "" And col > 12 And a > 0 And Trim(cammpo) <> "CAP" Then
campo = campo & Mid(MR, col + 1, a)
End If
End Sub
Private Sub Riempi_campo2()
Virg = " "
campo = ""
For Car = 1 To LC
col = col + 1
Virg = Mid(MR, col, 1)
If Virg = Chr(9) Then
Car = Car + 8
Else
campo = campo & Mid(MR, col, 1)
End If
Next Car
End Sub
Private Sub Riempi_campo3()
Virg = " "
campo = ""
For Car = 1 To LC
col = col + 1
Virg = Mid(MR, col, 1)
If Virg = Chr(9) Then
Car = Car + 5
Else
campo = campo & Mid(MR, col, 1)
End If
Next Car
End Sub
Per tutti: un sentito ringraziamento, e pongo con gioia la parola FINE a questo ennesimo puzzle, secondo me oramai risolto, dato che consente benissimo di lavorare!