Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Auteur Topic: Macro verkorten / verbeteren  (gelezen 99893 keer)

0 leden en 2 gasten bekijken dit topic.

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Macro verkorten / verbeteren
« Gepost op: 25 mei 2019, 18:28:12 »
Goeiedag ieder,

Ben er in geslaagd een macro en vba combinatie te maken (grotendeels door wat ik van jullie allen mocht leren ;)

Doch denk ik dat dit beter kan !

Bedoeling :
1) overbodige rijen wissen
2) deel van rijen splitsen naar kolommen
3) ander deel van rijen splitsen naar kolommen (ander aantal)
4) overbodige kolommen wissen
5) lege rijen tussen voegen

Daar dit een vertrouwelijk bestand is, is er geen bijlage sorry !

Sub Macro2()
'
' Macro2 Macro

[1:10,12:16,19:61,63:63,109:124].Delete


    Range("A1:A3").Select
    Selection.Cut Destination:=Range("N1:N3")
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(43, 1), Array(53, 1), Array(56, 1), _
        Array(63, 1), Array(71, 1), Array(81, 1), Array(85, 1)), TrailingMinusNumbers:=True
    Columns("A:I").Select
    Columns("A:I").EntireColumn.AutoFit
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:G").Select
    Selection.Delete Shift:=xlToLeft
    Range("J1").Select
    Selection.Cut Destination:=Range("B1")
    Columns("J:J").Select
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(43, 1), Array(52, 1), Array(61, 1), _
        Array(71, 1), Array(80, 1)), TrailingMinusNumbers:=True
    Range("M:M,P:P").Select
    Range("P1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("J2:N3").Select
    Selection.Cut Destination:=Range("A2:E3")
    Range("A2:E3").Select
   
   
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Rows("5:5").Select
    Selection.Insert Shift:=xlDown
   
End Sub


Alvast bedankt,

Georgyboy

Offline pitufo

  • Ambassadeur
  • *****
  • Berichten: 1.343
  • Geslacht: Man
Re: Macro verkorten / verbeteren
« Reactie #1 Gepost op: 26 mei 2019, 08:51:10 »
Hoi,

Als je met die macro telkens heel exact hetzelfde wil doen is hij zeker bruikbaar.
Maar ik zie er wel ettelijke keren "select" in staan, dat is volkomen overbodig en tijdrovend (in computerbegrippen).

Ik pik er zomaar eentje uit :
Columns("A:I").Select
Columns("A:I").EntireColumn.AutoFit
Daarin mag de eerste regel gewoon weg.

En :
Rows("2:2").Select
Selection.Insert Shift:=xlDown
kan je vervangen door :
Rows(2).Insert Shift:=xlDown
En zo verder telkens je diezelfde structuur aantreft.

Succes !
pitufo
"De computer doet wel degelijk wat je hem vraagt,
 maar NIET wat je DENKT dat je hem vraagt"

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #2 Gepost op: 26 mei 2019, 09:31:19 »
Bedankt Putifo

Daar leer ik van als VBA beginneling  :)

Vandaag zou ik op je stemmen  :D

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #3 Gepost op: 30 mei 2019, 16:59:19 »
Hallo ieder,

Kom er niet uit in VBA omdat ik er de kennis niet van heb,
Graag wil ik dit verder leren en ben blij al veel geleerd te hebben van jullie allen.
In bijlage Te importeren TXT bestand.
In Excel Rijen verwijderen, Tekst naar kolommen (bovenste deel niet gelijk aan onderste deel).
Lege rijen tussen plaatsen en kolommen max uitlijnen.

In excel voorbeeld
1° tabblad : TXT bestand
2° tabblad : Gewenst (gedaan met een macro (via recorder)
3° tabblad : 1° test VBA (rijen verwijderd)
4° tabblad : 2° test VBA (een ramp !!!) alles bijna weg

Versta niet goed de werking van de array(s) vb

“Array(Array(0, 1), Array(8, 1), Array(43, 1),”
1. Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(43, 1), Array(53, 1), Array(56, 1), _
        Array(64, 1), Array(71, 1), Array(81, 1), Array(86, 1)), TrailingMinusNumbers:=True
2. Selection.TextToColumns Destination:=Range("I1"), DataType:=xlFixedWidth, _
       FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(43, 1), Array(52, 1), Array(60, 1), _
      Array(66, 1), Array(69, 1), Array(80, 1)), TrailingMinusNumbers:=True


Sorry voor het niet kunnen/begrijpen


Alvast Bedankt

Georgyboy

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #4 Gepost op: 30 mei 2019, 17:00:28 »
Excel Bestand van vorige vraag (Topic)

Offline emields

  • Ervaren lid
  • ***
  • Berichten: 257
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #5 Gepost op: 30 mei 2019, 23:34:22 »
Probeer deze eens

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #6 Gepost op: 31 mei 2019, 07:46:17 »
Hey Emields,

Hartelijk dank  :)  :thumbsup:

Probeer dit weekend je code te begrijpen, wat ik nog niet kan


Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #7 Gepost op: 09 juni 2019, 18:51:30 »
Goede avond
@ Emields je code werkt zeer goed op het test bestandje zonder gevoelige informatie
op het gebruikte bestand heb ik onderstaande fout 1004, zie spijtig genoeg mijn fout niet, sorry

Sub Knop1_Klikken()
[blad1!b1] = ['TXT Bestand'!a11].Value
[blad1!a3] = ['TXT Bestand'!a15].Value
[blad1!a4].Resize(2) = ['TXT Bestand'!a17:a18].Value
[blad1!a7] = ['TXT Bestand'!a62].Value
x = Range(Sheets("TXT Bestand").Range("a64"), Sheets("TXT Bestand").Range("a64").End(xlDown)).Rows.Count
[blad1!a8].Resize(x) = ['TXT Bestand'!a64].Resize(x).Value ' fout 1004
With Sheets("blad1")
    .Range("A3:A52").TextToColumns Destination:=Range("A3"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(42, 1), Array(53, 1), Array(58, 1), _
        Array(65, 1), Array(71, 1), Array(83, 1), Array(84, 1)), TrailingMinusNumbers:=True
    .Range("D:E,H:I").Delete Shift:=xlToLeft
    .Range("B8").End(xlDown).Offset(1, -1).Resize(20).ClearContents
    .Columns("A:E").Columns.AutoFit
End With
End Sub

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #8 Gepost op: 09 juni 2019, 18:54:59 »
Fout

[blad1!a8].Resize(x) = ['TXT Bestand'!a64].Resize(x).Value

Offline emields

  • Ervaren lid
  • ***
  • Berichten: 257
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #9 Gepost op: 09 juni 2019, 19:09:10 »
wijzig
 en verplaats volgende zin

[blad1!a8].Resize(x) = ['TXT Bestand'!a64].Resize(x).Value




With Sheets("blad1")
    .Range("a8").Resize(x) = ['TXT Bestand'!a64].Resize(x).Value

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #10 Gepost op: 09 juni 2019, 19:37:58 »
Bedankt Emields


Proberen aan te passen, maar krijg melding : compileerfout : End Witch

ub Knop1_Klikken()
[blad1!b1] = ['TXT Bestand'!a11].Value
[blad1!a3] = ['TXT Bestand'!a15].Value
[blad1!a4].Resize(2) = ['TXT Bestand'!a17:a18].Value
[blad1!a7] = ['TXT Bestand'!a62].Value
x = Range(Sheets("TXT Bestand").Range("a64"), Sheets("TXT Bestand").Range("a64").End(xlDown)).Rows.Count
With Sheets("blad1")
    .Range("a8").Resize(x) = ['TXT Bestand'!a64].Resize(x).Value
[blad1!a8].Resize(x) = ['TXT Bestand'!a64].Resize(x).Value
With Sheets("blad1")
    .Range("A3:A52").TextToColumns Destination:=Range("A3"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(42, 1), Array(53, 1), Array(58, 1), _
        Array(65, 1), Array(71, 1), Array(83, 1), Array(84, 1)), TrailingMinusNumbers:=True
    .Range("D:E,H:I").Delete Shift:=xlToLeft
    .Range("B8").End(xlDown).Offset(1, -1).Resize(20).ClearContents
    .Columns("A:E").Columns.AutoFit
End With
End Sub

Offline Haije

  • Excel-Expert
  • Volledig lid
  • *****
  • Berichten: 197
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #11 Gepost op: 09 juni 2019, 19:40:46 »
Georgyboy,

haal deze twee regels weg:
[blad1!a8].Resize(x) = ['TXT Bestand'!a64].Resize(x).Value
With Sheets("blad1")
|-|aije

ik gebruik Office 2016 Professional Plus

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #12 Gepost op: 09 juni 2019, 19:51:29 »
Hey Haije, bedankt

Blijft hangen op : .Range("a8").Resize(x) = ['TXT Bestand'!a64].Resize(x).Value (fout 1004 compileer)

Sub Knop1_Klikken()
[blad1!b1] = ['TXT Bestand'!a11].Value
[blad1!a3] = ['TXT Bestand'!a15].Value
[blad1!a4].Resize(2) = ['TXT Bestand'!a17:a18].Value
[blad1!a7] = ['TXT Bestand'!a62].Value
x = Range(Sheets("TXT Bestand").Range("a64"), Sheets("TXT Bestand").Range("a64").End(xlDown)).Rows.Count
With Sheets("blad1")
    .Range("a8").Resize(x) = ['TXT Bestand'!a64].Resize(x).Value
    .Range("A3:A52").TextToColumns Destination:=Range("A3"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(42, 1), Array(53, 1), Array(58, 1), _
        Array(65, 1), Array(71, 1), Array(83, 1), Array(84, 1)), TrailingMinusNumbers:=True
    .Range("D:E,H:I").Delete Shift:=xlToLeft
    .Range("B8").End(xlDown).Offset(1, -1).Resize(20).ClearContents
    .Columns("A:E").Columns.AutoFit
End With
End Sub

Offline RedHead

  • Excel-Expert
  • Ambassadeur
  • *****
  • Berichten: 2.277
  • Geslacht: Man
  • Met Excel lukt 't wel.... (toch???)
Re: Macro verkorten / verbeteren
« Reactie #13 Gepost op: 09 juni 2019, 20:43:25 »
Check even wat de waarde is van variabele x is als de foutmelding verschijnt...
______________________________

Groet, Leo

Offline Georgyboy

  • Ervaren lid
  • ***
  • Berichten: 314
  • Geslacht: Man
  • Oplossing.be
Re: Macro verkorten / verbeteren
« Reactie #14 Gepost op: 09 juni 2019, 21:21:10 »
Bedankt Redhead

Heb er het bestandje bijgevoegd, is misschien voor jullie zo duidelijker.
Sorry voor de vervorming van de tekst (is een intern document)

Alvast bedankt


 


www.combell.com