[Excel] macro che incastra più righe in un file txt

[Marcello Ferrau]

Buonasera a tutti.
Grazie a questo forum mi sto sbizzarrendo a mettere in piedi macro per alcuni miei lavori.
Ultimamente mi sto dedicando a modificare dei file di testo attraverso il:

Codice: Seleziona tutto

Worksheets("Foglio1").Activate
    fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

    If fileToOpen = False Then
        Sheets("Foglio1").Cells(1, 1) = ""
        Exit Sub
    Else
        Sheets("Foglio1").Cells(1, 1) = fileToOpen
    End If

    mycell = fileToOpen
    myfile = ThisWorkbook.Sheets("Foglio1").[A1] & "Mod.txt"

    Open mycell For Input As #1
    Open myfile For Output As #2


e quindi un ciclo Do While Not EOF.

Riesco però solo a "modificare" le singole righe. riga per riga, ma quello che vorrei provare a fare è incastrare due righe successive se si verifica una certa condizione.

Vi faccio subito l'esempio che è decisamente più efficace di ogni parola.

I miei file di testo sono così organizzati (testo originale):
------------
C00007336836 SASSARI 10
3provaprovaprovaprovaprovaprovaprovaprovaprovaprova
C00007522954 SASSARI 10
3can che abbaia
C00002965873 SASSARI 15
C00007094942 SASSARI 15
------------
(tra SASSARI e il numero ci sono 55 spazi vuoti)

con un ciclo if vorrei che se Mid$(v, 1, 1) = "3"
allora vengano presi i primi 30 caratteri della riga che comincia con 3 (ma dopo il 3 e indipendentemente dalla lunghezza) e vengano incastrati tra la posizione 44 e 73 della riga precedente, altrimenti si printa la riga così come è. In pratica vorrei ottenere il seguente risultato (testo Mod):
------------
C00007336836 SASSARI provaprovaprovaprovaprovaprova 10
C00007522954 SASSARI can che abbaia 10
C00002965873 SASSARI 15
C00007094942 SASSARI 15
------------

Come potrei risolvere?
Grazie mille in anticipo

[ricky53]

Ciao,
puoi inviare la tua macro completa.
Se invii anche un file TXT di esempio ci "aiuterai" ad "aiutarti"

[Marcello Ferrau]

Ciao Ricky,

ti posto un codice fallato, perché la parte dell'incastro proprio non so come ottenerla:

Codice: Seleziona tutto

Sub Prova()

    Dim v As Variant
    Dim car6 As Variant
    Dim r As Long
   
    Worksheets("Foglio1").Activate
    fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

    If fileToOpen = False Then
        Sheets("Foglio1").Cells(1, 1) = ""
        Exit Sub
    Else
        Sheets("Foglio1").Cells(1, 1) = fileToOpen
    End If

    mycell = fileToOpen
    myfile = ThisWorkbook.Sheets("Foglio1").[A2] & "Mod.txt"
   
    Open mycell For Input As #1
    Open myfile For Output As #2
   
    r = 2
    conta = 0
   
    Do While Not EOF(1)
        Line Input #1, v
        If Mid$(v, 1, 1) = "3" Then
             ' qui ci vorrebbe un codice che incastri le righe come scritto in apertura, ma non so come fare xD
        Else
            Print #2, v
        End If
     Loop
        Close #1
        Close #2
       
        MsgBox ("ELABORAZIONE TERMINATA!")
       
End Sub

Ti linko due file txt in un rar, uno provaOrig.txt che sarebbe quello di partenza, e uno provaMod.txt come mi piacerebbe che diventasse. Non so se posso fare altro per esservi di aiuto. Eventualmente chiedete

http://www.mondometalwebzine.com/prova.rar

Dimenticavo, nel Foglio1 di excel, per eseguire la macro, ho messo queste due formule nelle celle A2 e A3:

A2 =STRINGA.ESTRAI(A1;1;A3-4)
A3 =LUNGHEZZA(A1)

[Flash30005]

Mi sembra di capire che non vuoi l'importazione in un file excel e quindi, con la seguente macro, creo un secondo file.txt nella stessa directory del file.txt originale.

Codice: Seleziona tutto

Sub LeggeScriveTxt()
Perc = "C:\Temp\"
Open Perc & "Testo1.txt" For Input As #1
    Open Perc & "Testo2.txt" For Output As #2
    Do Until EOF(1)
        Line Input #1, Riga1
        Line Input #1, Riga2
        MiaRiga2 = ""
        If Mid(Riga2, 1, 1) = "3" Then
        MiaRiga2 = Mid(Riga2, 2, 30)
        'If Len(MiaRiga2) < 30 Then
        Agg = ""
        For LR = Len(MiaRiga2) + 1 To 30
        Agg = Agg & " "
        Next LR
       ' End If
            RigaP = Mid(Riga1, 1, 20) & "                       " & MiaRiga2 & Agg & " " & Right(Riga1, 2)
            Print #2, RigaP
        Else
        Agg = ""
        For LR = Len(MiaRiga2) + 1 To 30
        Agg = Agg & " "
        Next LR
            Print #2, Mid(Riga1, 1, 20) & "                       " & MiaRiga2 & Agg & " " & Right(Riga1, 2)
            Print #2, Mid(Riga2, 1, 20) & "                       " & MiaRiga2 & Agg & " " & Right(Riga2, 2)
        End If
    Loop
    Close #2
Close #1
End Sub

Temo, comunque, che in taluni casi possa errare perché dovrei avere più righe per testarla a fondo, ma penso che possa farlo tu.

ciao

[Anthony47]

Credo che serva qualcosa di piu' articolato che non quanto proposto da Flash sopra, perche' i casi sono vari.
Questa ipotesi e' derivata dalla macro originale di Marcello Ferrau:

Codice: Seleziona tutto

Sub ProvAnth()
'
Dim V, V2
'Dim car6 As Variant
'Dim r As Long
'       
Close #1: Close #2
'
Worksheets("Foglio1").Activate
fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
'
If fileToOpen = False Then
    Sheets("Foglio1").Cells(1, 1) = ""
    Exit Sub
Else
    Sheets("Foglio1").Cells(1, 1) = fileToOpen
End If
'
mycell = fileToOpen
myfile = ThisWorkbook.Sheets("Foglio1").[A2] & "Mod.txt"
'       
Open mycell For Input As #1
Open myfile For Output As #2
'       
'r = 2
'conta = 0
'       
Do While Not EOF(1)
    If V = "" Then Line Input #1, V
    If Not EOF(1) Then Line Input #1, V2
    If Mid$(V2, 1, 1) = "3" Then
        newv = Left(V, 43) & Mid(V2, 2, 30) & String(30 - Len(Mid(V2, 2, 30)), " ") & Mid(V, 74, 99)
        Print #2, newv
        V = "": V2 = ""
    Else
        Print #2, V
        V = V2: V2 = ""
    End If
Loop
If V <> "" Then Print #2, V
Close #1
Close #2
MsgBox ("ELABORAZIONE TERMINATA!")
End Sub


Fai sapere, ciao.

[Marcello Ferrau]

Ciao Flash, ciao Anthony, innanzitutto grazie per la sempre pronta risposta

Ho testato le due proposte su un file decisamente più "corposo" di quello allegato, e ho trovato quella di Anthony decisamente perfetta, anche perché più in linea in effetti con l'impostazione iniziale della mia bozza.
E ho avuto modo di imparare anche come operare su righe differenti!

Vi ringrazio di cuore ragazzi, è sempre un piacere girare questo forum e scoprire che si può sempre trovare qualcosa di nuovo
Buona domenica a tutti!