[excel]enorme hoeveelheid text groeperen [ DEEL 2 ]

[666AnGeL]

BTM909 heeft me een paar weken geleden geholpen om een macro te maken om wat dingen te automatiseren;

[excel]enorme hoeveelheid text groeperen

Toen dacht ik dat ik maximaal 10 regels moest groeperen,
helaas is dit nu 25 maximaal geworden waardoor ik dus de macro niet kan gebruiken.

Ik heb zelf al vanalles geprobeerd met macro's opnemen e.d.
en de macro van btm909 aan te passen , maar het lukt niet.
(wel deels maar ik ben bang dat als ik het toepas op 16.000 regels dat
er fouten in komen die ik niet zo zie..)

Dus mijn vraag is , hoe kan ik de onderstaande macro aanpassen om met max. 25 regels te kunnen werken?

code:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' VBA code created by BtM909
' 11 February 2004
'
' This code will transpose the selection next to the first selected item.
' Besides that, there will be a concatenation of the first 10 columns.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim totaalRegels, eindReeks, teller, charPos As Integer

Sub shuffleCells()

Application.ScreenUpdating = False

    Sheets(2).Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets(1).Select
    Range("A1").Select

    totaalRegels = Sheets(1).Range("A1").End(xlDown).Row

    For teller = 1 To totaalRegels

        If ActiveCell.Value = "" Then
            Range("A1").Select
            GoTo bijnaKlaar
        End If

        eindReeks = 1

        ActiveCell.Offset(1, 0).Select

        While InStr(ActiveCell.Value, "#") < 1 And ActiveCell.Value <> ""
            ActiveCell.Offset(1, 0).Select
            eindReeks = eindReeks + 1
        Wend
        
        Range("A1", "A" & eindReeks).Select
        Selection.Copy

        Sheets(2).Range("A" & teller).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True

        Selection.EntireRow.Delete

    Next teller

bijnaKlaar:

    'Zet de data weer op de originele plek
    Sheets(2).Select
    Cells.Select
    Selection.Cut
    Range("A1").Select
    Sheets(1).Select
    Cells.Select
    ActiveSheet.Paste

    'Haal de extra character weg
    Columns("A:A").Select
    Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").Select

    ' Maak alles na 10 kolommen leeg en zet de concatenate functie in kolom 11
    Columns("K:K").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
    Range("L1").Select

    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2])"
    Selection.Copy
    Range("L2:L" & totaalRegels).Select
    ActiveSheet.Paste
    Range("A1").Select

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Ik heb al gezien dat ik dit moet aanpassen:

code:

ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC

dit moet het dan worden:

code:

ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(RC[-25],RC[-24],RC[-23],RC[-22],RC[-21],RC[-20],RC[-19],RC[-18],RC[-17],RC[-16],RC[-15],RC[-14],RC[-13],RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC

Maar wat moet er nog meer gebeuren om het goed te krijgen?

Ik hoop dat iemand me er verder meer kan helpen!
Alvast bedankt!

[Verwijderd]

moet je niet beginnen met: concatenate (RC [-26] etc etc.....

[ Voor 5% gewijzigd door Verwijderd op 12-03-2004 12:28 ]

[Lustucru]

Geeft BTM geen suport op geleverde code? Iig vanaf regel 69:
alle kolomK verwijzingen wijzigen in Y (je schrijft meer kolommen weg)
alle kolom L verwijzingen wijzigen in Z (idem)
en concatenate idd beginnen op rc[-26]

[BtM909]

Niesje schreef op 12 maart 2004 @ 13:05:
Geeft BTM geen suport op geleverde code? Iig vanaf regel 69:
alle kolomK verwijzingen wijzigen in Y (je schrijft meer kolommen weg)
alle kolom L verwijzingen wijzigen in Z (idem)
en concatenate idd beginnen op rc[-26]

Nope .

Voor mij geldt altijd:

_{disclaimer: garantie tot aan de knop "verstuur bericht"}

Volgens mij kan 666AnGeL met jouw tips wel verder

[BtM909]

Sorry voor de kick, maar dit is staat totaal los van m'n vorige post.

Hieronder de aanpassingen om de macro te laten werken:

code:

'Haal de extra character weg
Columns("A:A").Select
Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

' Maak alles na 25 kolommen leeg en zet de concatenate functie in kolom 30
Columns("Z:Z").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("AD1").Select
    
totaalRegels = Sheets(1).Range("A1").End(xlDown).Row

ActiveCell.FormulaR1C1 = _
    "=CONCATENATE(RC[-29],RC[-28],RC[-27],RC[-26],RC[-25],RC[-24],RC[-23],RC[-22],RC[-21],RC[-20],RC[-19],RC[-18],RC[-17],RC[-16],RC[-15],RC[-14],RC[-13],RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5])"
Selection.Copy
Range("AD2:AD" & totaalRegels).Select
ActiveSheet.Paste
Range("A1").Select

Wat heb ik aangepast:
[list]
• 'Haal de extra character weg: dit stuk selecteerde nog cel A1 op 't eind, maar dat is helemaal niet nodig
• Vanaf kolom Z wordt alles leeggemaakt
• Er wordt opnieuw opgehaald hoeveel regels er zijn (het aantal regels is minder dan waarmee je begint).
• De concatenate functie is aangepast. In de 30^e kolom wordt de functie geplaatst, dus de concatenate begint met -29


_{noot: ik dacht trouwens dat TS er ook nog spaties tussen voegde (maar dat kan hij vast wel zelf oplossen )}

offtopic:
wanneer wordt die automagisch inklapmodus voor lange code actief

[ Voor 14% gewijzigd door BtM909 op 15-03-2004 14:35 ]

[BtM909]

* BtM909 is benieuwd of 666AnGeL er inmiddels uit is ?