Tekst naar kolommen in macro werkt niet goed

Dwaze · 19 nov 2020

Geacht forum,

Ik heb een probleem met een macro.
Als ik het aanmaak door in blad2, kolom R de tekst naar kolommen doe en die invul in kolommen A B_C_ vervolgens nog een keer vanaf C naar E en F
omdat het sceidings streepje gescheiden moet worden. Dan sorteren op C datum en A getal, dan gaat dat perfect. Maar... als ik dan de macro laat uitvoeren ontbreken gegevens in Blad1 waar die anders met het opmaken van de macro wel ingevuld werden.
Wat ontbreekt er aan de macro?

Groet Evert

globe · 19 nov 2020

je verwijst naar kolom R in Blad1

ik vermoed dat je kolom R in blad2 wilt hebben?

zet tussen het selecteren van kolom R

het volgende:

Code:

Sheets("Blad2").Select

verder staan er nog meer selectie in je code, maar je geeft niet aan uit welk werkblad er geselecteerd moeten worden, daar gaat het mis.

Dwaze · 19 nov 2020

Nee hoor. Kolom R staat in Blad2. die moet dan in hetzelfde blad tekst kolommen naar A B C D E F in hetzelfde blad. Zo heb ik dat in de macro gedaan.
Die verwijzing in Blad1 is naar een ander blad Comp.

globe · 19 nov 2020

Dan moet je als allereerste blad2 selecteren in je code.

Als ik hem draai vanuit blad1, wat standaard gebeurd leegt hij in blad 1 de cellen en probeert vervolgens in blad 1 kolom R te kopiëren.

Je moet dus de regel toevoegen om blad2 te selecteren.

code moet dus worden:

Code:

Sub Macro1()
'
' Macro1 Macro
' test
'

'toegevoegd aan macro

Sheets("Blad2").Select


    Columns("A:F").Select
    Selection.ClearContents
    'Application.Left = 35.5
   ' Application.Top = 30.25
    Columns("R:R").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(8, 1), Array(15, 9), Array(21, 1)), _
        TrailingMinusNumbers:=True
    Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    Columns("A:F").Select
    ActiveWorkbook.Worksheets("Blad2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Blad2").Sort.SortFields.Add Key:=Range("C1:C400") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="datum", _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Blad2").Sort.SortFields.Add Key:=Range("A1:A400") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Blad2").Sort
        .SetRange Range("A1:F400")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("I20:I21").Select
    Range("I21").Activate
End Sub

Dwaze · 19 nov 2020

Blijft dezelfde fout maken.
Kan je misschien die code in het voorbeeld bestandje plaatsen, want het kan zijn dat ik iets niet goed doe.

Bvb dank
Evert

globe · 19 nov 2020

denk dat ie zo goed gaat.

Ik heb de beide application regels uitgezet, kreeg ik een fout op en voegen niks toe

JEC. · 19 nov 2020

Ik denk dat je je hele code zo kan schrijven

Code:

Sub jv()
    With Sheets("Blad2")
         Columns("A:F").ClearContents
        .Range("R:R").TextToColumns .Range("A1"), xlFixedWidth, , , , , , , , , Array(Array(0, 1), Array(5, 1), Array(8, 1), Array(15, 9), Array(21, 1)), , , 1
        .Range("D:D").TextToColumns .Range("D1"), xlDelimited, 1, , , , , , 1, "-", Array(Array(1, 1), Array(2, 1), Array(3, 1)), 1
        .Columns(1).Sort .Range("A1")
        .Columns(3).Sort .Range("C1")
    End With
End Sub

Dwaze · 19 nov 2020

Globe:

Het werkt nog steeds niet , Kolommen 23-24-26-40-42-44-47 gaan dan leeg terwijl met het opmaken van de macro die wel zijn gevuld.

Jveer:
Deze oplossing werkt ook niet , het verbouwd zelfs het blad Comp.

Blijft dus lastig.

JEC. · 19 nov 2020

Het tekst naar kolommen deel doet het prima. Ik weet niet wat je verder wil bereiken naast het scheiden en sorteren.

globe · 19 nov 2020

Dwaze zei:
Globe:

Het werkt nog steeds niet , Kolommen 23-24-26-40-42-44-47 gaan dan leeg terwijl met het opmaken van de macro die wel zijn gevuld.

Jveer:
Deze oplossing werkt ook niet , het verbouwd zelfs het blad Comp.

Blijft dus lastig.

Voer de macro een stap voor stap uit. dan zie je wanneer er iets gebeurd en wat er dan mis gaat

je geeft namelijk in je code aan dat de kolommen leeg moeten worden gemaakt.

Dwaze · 19 nov 2020

Die kolommen die dan ontstaan worden gekopieerd naar blad Comp. Daar gaat het niet goed. Want in dat blad zijn er verwijzingen naar Blad1 zodat die regels ingevoerd worden. Het gekke is dat het wel lukt om het handmatig te doen (die tekst in kolommen en sorteren en kopieren dan) maar als ik de macro gedraaid heb en dan die kolommen weer kopieer naar blad Comp gaat het niet goed.

JEC. · 19 nov 2020

Zo dan?

Edit: De code nog een klein beetje aangepast. Bij mij gaat het nu goed

Code:

Sub jvtest()
    With Sheets("Blad2")
        .Columns("A:F").ClearContents
        .Range("R:R").TextToColumns .Range("A1"), 2, , , , , , , , , Array(Array(0, 1), Array(5, 1), Array(8, 1), Array(15, 9), Array(21, 1)), , , 1
        .Range("D:D").TextToColumns .Range("D1"), 1, 1, , , , , , 1, "-", Array(Array(1, 1), Array(2, 1), Array(3, 1)), 1
        .Sort.SortFields.Add Range("C1:C400")
        .Sort.SortFields.Add Range("A1:A400")
      With .Sort
       .SetRange Sheets("Blad2").Range("A1:F400")
       .Apply
      End With
    End With
End Sub

Dwaze · 19 nov 2020

Nee, ook niet. Het lijkt erop dat als de macro zijn werk gedaan heeft ,dat dan die kolommen niet gesorteerd kunnen worden. Althans niet op de normale manier zoals dat met het invoeren wel kan. Volgens mij is dat het probleem .

globe · 19 nov 2020

Sorteren gaat mis omdat de datum in kolom C verschillende opmaak heeft.

Kijk maar wat er gebeurd vanaf rij 167.

Zet voor de gein je celeigenschappen maar op datum notatie

op te lossen door ipv OKT -> OCT te gebruiken in je datum

globe · 19 nov 2020

Code:

Sub Macro1()


Sheets("Blad2").Select


    Columns("A:F").Select
    Selection.ClearContents
    'Application.Left = 35.5
    'Application.Top = 30.25
    Columns("R:R").Select
    Selection.Replace What:="okt", Replacement:="oct"
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(8, 1), Array(15, 9), Array(21, 1)), _
        TrailingMinusNumbers:=True
    Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    Columns("A:F").Select
    ActiveWorkbook.Worksheets("Blad2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Blad2").Sort.SortFields.Add Key:=Range("C1:C400") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="datum", _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Blad2").Sort.SortFields.Add Key:=Range("A1:A400") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Blad2").Sort
        .SetRange Range("A1:F400")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("I20:I21").Select
    Range("I21").Activate
End Sub

Dit gaat goed.

In deze code wordt voordat er wat gekopieerd wordt vanuit kolom R, eerst OKT door OCT vervangen

JEC. · 19 nov 2020

Globe was me net voor.:thumb:

Code:

Sub jvtest()
    With Sheets("Blad2")
        .Columns("A:F").ClearContents
        .Range("R:R").TextToColumns .Range("A1"), 2, , , , , , , , , Array(Array(0, 1), Array(5, 1), Array(8, 1), Array(15, 9), Array(21, 1)), , , 1
        .Range("D:D").TextToColumns .Range("D1"), 1, 1, , , , , , 1, "-", Array(Array(1, 1), Array(2, 1), Array(3, 1)), 1
        .Range("C:C").Replace "okt", "oct"
        .Sort.SortFields.Add Range("C1:C400")
        .Sort.SortFields.Add Range("A1:A400")
      With .Sort
       .SetRange Sheets("Blad2").Range("A1:F400")
       .Apply
      End With
    End With
End Sub

Dwaze · 19 nov 2020

Lukt ook niet. Heb dat al eerder geprobeert die opmaak lukt niet.

JEC. · 19 nov 2020

Dan is het voor mij totaal onduidelijk wat nu het probleem is.

Dwaze · 19 nov 2020

Top heren, dit is het. Hoe kan je nou bedenken dat OKT ,OCT moet zijn. Knap hoor.

Ik dank jullie allebei voor de getoonde moeite en oplossingen.

Groet Evert

globe · 19 nov 2020

tsja...

ik zag het toevallig toen ik de celeigenschappen veranderde, kun je idd uren druk mee zijn

Tekst naar kolommen in macro werkt niet goed

Gebruiker

Bijlagen

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Bijlagen

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Verenigingslid

Gebruiker

Terugkerende gebruiker

Gebruiker

Verenigingslid

Verenigingslid

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Verenigingslid

Wij waarderen jouw privacy