Kolommen van gelijke lengte

[kabebanaan]

Hallo,

Is het mogelijk om 1 kolom op te splitsen naar bijv. 4 kolommen van gelijke lengte (zonder knippen/plakken)?
Is bijvoorbeeld A1 t/m A28 gevuld, dan wil ik deze splitsen in 4 kolommen van 7 waarden.

Is er misschien een limiet te stellen aan de lengte van een kolom?

 

[Wim1960]

Je probleem is mij niet helemaal duidelijk, maar als je de inhoud van cellen in een kolom wilt splitsen in 4 kolommen, is Tekst naar kolommen misschien iets voor je.

Je kunt dit vinden onder data. Even de kolom/cellen selecteren en kiezen voor data/tekst naar kolommen. Daarna kan je kiezen voor een teken waar je op wilt splitsen of een vaste breedte.

 

[Wigi]

Allright, een beetje een vreemde vraag (zonder knippen en plakken zeker); maar misschien is dit wat je zoekt:

Zet in ThisWorkbook:

Private Sub Workbook_Open()
instellingen
End Sub

Zet in een nieuwe module:

Public kolom As Integer
Public aantalrijen As Long
Sub instellingen()
kolom = InputBox("In welke kolom wil je het aantal rijen beperken?")
aantalrijen = InputBox("Hoeveel rijen wil je maximaal gebruiken?")
End Sub

Ten slotte, zet in de code achter het werkblad waar je het aantal rijen wil beperken:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(kolom)) Is Nothing Then
        If Not Intersect(Target, Rows(aantalrijen)) Is Nothing Then
            MsgBox "Je hebt de ingestelde limiet van " & aantalrijen & " bereikt." & vbCr _
                & "Ga verder in een nieuwe kolom."
            Application.EnableEvents = False
                Target.Clear
            Application.EnableEvents = True
        End If
    End If
End Sub

Wigi

PS: wanneer gevraagd wordt naar een kolom, voer dat in als een cijfer: A = 1, B = 2, enz.) Je kan dan indien gewenst zelf nog aanpassingen maken om het te verbeteren.

 

[kabebanaan]

Ten slotte, zet in de code achter het werkblad waar je het aantal rijen wil beperken:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(kolom)) Is Nothing Then
        If Not Intersect(Target, Rows(aantalrijen)) Is Nothing Then
            MsgBox "Je hebt de ingestelde limiet van " & aantalrijen & " bereikt." & vbCr _
                & "Ga verder in een nieuwe rij."
            Application.EnableEvents = False
                Target.Clear
            Application.EnableEvents = True
        End If
    End If
End Sub

De foutmelding die ik krijg is:

If Not Intersect(Target, Columns(kolom)) Is Nothing Then

 

[Wigi]

De foutmelding die ik krijg is:

If Not Intersect(Target, Columns(kolom)) Is Nothing Then

Wat heb je ingevuld in de inputboxes?

 

[kabebanaan]

Misschien dat daar de fout door komt.
Hoe vul ik dit in (tussen aanhalingsteken o.i.d)?

Als je mij een voorbeeldje zou willen geven, dan red ik me vast wel.

 

[Wigi]

Vul bv. in de eerste inputbox:

1

Vul bv. in de tweede inputbox:

10

Dit betekent dat je in kolom A (de 1 dus) enkel de eerste 9 rijen mag gebruiken.

Typ dan maar eens iets in A10.

Lukt het dan?

Wigi

 

[kabebanaan]

Ik heb het volgende ingevuld:

Public kolom As Integer
Public aantalrijen As Long
Sub instellingen()
kolom = InputBox(1)
aantalrijen = InputBox(10)
End Sub

Maar krijg dezelfde foutmelding.

 

[Wigi]

Als je nu gewoon eens dit bestand opent en 1 en 10 invult. Dan naar cel A10 gaan en iets invullen.

 

[LucB]

Karel,

Ik denk toch dat je dit bedoeld.

 

[Wigi]

Karel,

Ik denk toch dat je dit bedoeld.

Dat denk ik ook al lang, maar er is uitdrukkelijk gesteld dat knippen en plakken niet kan.

 

[Wigi]

Als dat dus is wat je wilt, de "paper saver" bij de ASAP utilities doet dit bv.

Wigi

 

[kabebanaan]

Dat denk ik ook al lang, maar er is uitdrukkelijk gesteld dat knippen en plakken niet kan.

Sorry .... knippen en plakken mag wel natuurlijk, maar zag mezelf niet elke keer handmatig de kolom knippen en plakken, maar wilde dit door een macro laten doen.

De oplossing van LucB is hetgene ik zocht.
Maar die van Wigi hou ik in gedachten .... kan zoiets in de toekomst vast nog wel is gebruiken.

Bedankt allen !!!!!!

 

[Wigi]

Ik heb de code van LucB wat aangepast:

Sub OpsplitsTabel()
    Application.ScreenUpdating = False
    Dim col As Integer, rngToSplit As Range, i As Integer, part As Long
    
    col = InputBox("In hoeveel kolommen wil je het bereik splitsen?")
    Set rngToSplit = Range("A1", Range("A" & Rows.Count).End(xlUp))
    part = WorksheetFunction.RoundUp(rngToSplit.Rows.Count / col, 0)
    For i = 2 To col
        rngToSplit((i - 1) * part + 1).Resize(part).Cut Cells(1, i)
    Next
    ActiveSheet.Columns(1).Resize(, col).AutoFit
    Application.ScreenUpdating = True
End Sub

Veel plezier ermee.

Wigi