Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Accorpamento testo

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Accorpamento testo

Postdi Statix » 11/04/18 23:36

Ciao a tutti,
dovrei modificare una macro di Anthony47
in quanto il file di testo ha 2/3 varianti invece di una
esempio
se la domanda è in colonna B1 e le 4 risposte sono in colonna B2 B3 B4 B5
la macro funziona e accorpa tutto in una sola cella B1
mentre se la domanda è in colonna B1 e le 4 risposte sono in B2 C2 B3 C3
la macro funziona in parte, accorpa solo la B2
la macro perfetta sarebbe quella che mettesse in ordine di righe le domande in B e le risposte in C D E F
http://www.filedropper.com/test_550

Codice: Seleziona tutto
Sub Assemblad()
Dim OutSh As String, LastA As Long, I As Long, J As Long, CNum As Long
Dim K As Long, OI As Long, myB As String, myC As String, myD As String, myE As String, myF As String
OutSh = "Foglio2"         '<<<<
Sheets(OutSh).Cells.ClearContents
LastA = Cells(Rows.Count, 1).End(xlUp).Row + 10
For I = 1 To LastA
    CNum = Cells(I, 1)
    For K = 1 To 10
        If Cells(I + K, 1) <> "" Then Exit For
    Next K
    myB = "": myC = "": myD = "": myE = "": myF = ""
    For J = 1 To K
        myB = myB & " " & Cells(I + J - 1, 2)
        myC = myC & " " & Cells(I + J - 1, 3)
        myD = myD & " " & Cells(I + J - 1, 4)
        myE = myE & " " & Cells(I + J - 1, 5)
        myF = myF & " " & Cells(I + J - 1, 6)
    Next J
    OI = OI + 1
    Sheets(OutSh).Cells(OI, 1) = CNum
    Sheets(OutSh).Cells(OI, 2) = Trim(myB)
    Sheets(OutSh).Cells(OI, 3) = Trim(myC)
    Sheets(OutSh).Cells(OI, 4) = Trim(myD)
    Sheets(OutSh).Cells(OI, 5) = Trim(myE)
    Sheets(OutSh).Cells(OI, 6) = Trim(myF)
    I = I + K - 1
Next I
End Sub
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1270
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Accorpamento testo

Postdi patel » 12/04/18 09:08

Statix ha scritto:Ciao a tutti,
dovrei modificare una macro di Anthony47
in quanto il file di testo ha 2/3 varianti invece di una

Ma tu non hai allegato esempi delle varianti
patel
Utente Senior
 
Post: 309
Iscritto il: 24/04/12 16:03

Re: Accorpamento testo

Postdi Statix » 12/04/18 12:50

Ciao patel,
ho postato un file test dove nel foglio2 ci sono i risultati dell'accorpamento di testo,
vedrai che i risultati sono diversi , in base alle varianti,
la macro inizialmente è stata creata per accorpare le celle con testo ,domanda e risposte in una sola riga,
la macro funziona perfettamente con l'esempio 1
mentre con gli altri 2 esempi non va perfettamente.

Codice: Seleziona tutto
esempio 1
domanda      B1
risposta  A)  B2
risposta  B)  B3
risposta  C) B4
risposta  D) B5

esempio  2
domanda      B1
risposta  A)  B2
risposta  B)  C2
risposta  C)  D2
risposta  D)  E2

esempio 3
domanda      B1
risposta  A)  B2
risposta  B)  C2
risposta  C) B3
risposta  D) C3

Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1270
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Accorpamento testo

Postdi Anthony47 » 14/04/18 00:29

Non voglio nemmeno guardare un codice che non si sa per che cosa era stato sviluppato e su quale struttura dati.
Prendo invece per buona la richiesta "la macro perfetta sarebbe quella che mettesse in ordine di righe le domande in B e le risposte in C D E F"

A me pare che questa macro lo faccia:
Codice: Seleziona tutto
Sub Machec()
Dim I As Long, OSh As Worksheet, nextD As Long, J As Long
Dim aArr, myMatch
'
Set OSh = Sheets("Foglio3")         '<<< Il foglio su cui si crea il risultato
'
aArr = Array("A)", "B)", "C)", "D)")
Sheets("Foglio1").Select
For I = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    If IsNumeric(Cells(I, 1)) Then
        nextD = OSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
        OSh.Cells(nextD, 1) = Cells(I, 1)
        OSh.Cells(nextD, 2) = Cells(I, 2)
    Else
        For J = 2 To 5
        If Cells(I, J) <> "" Then
            myMatch = Application.Match(Left(Cells(I, J), 2), aArr, False)
            If Not IsError(myMatch) Then
                OSh.Cells(nextD, myMatch + 2) = Cells(I, J)
            End If
        End If
        Next J
    End If
Next I
End Sub

Personalizza l'istruzione marcata <<< come da commento; il foglio che viene indicato deve gia' esistere e le sue colonne A:F SARANNO AZZERATE SENZA PREAVVISO all'avvio della macro prima di ricreare l'elenco.

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 17650
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Accorpamento testo

Postdi Statix » 14/04/18 21:55

Ciao Anthony47
tutto ok, grazie tante,
con la tua macro ho risparmiato circa 3-4 ore di lavoro,
ogni tanto mi capita che qualche buon amico mi chiede di aggiustare delle banche dati,

grazie ancora
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1270
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta


Torna a Applicazioni Office Windows


Topic correlati a "Accorpamento testo":


Chi c’è in linea

Visitano il forum: Nessuno e 45 ospiti