• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Verwijderen van

Status
Niet open voor verdere reacties.

dragon84

Nieuwe gebruiker
Lid geworden
10 okt 2006
Berichten
2
hoi

ik zit met het volgende probleem. ik heb een macro die gegevens uit een .txt bestand haalt en dat doet het pas als ik mijn snelkoppelings toets heb ik gedrukt. ik heb wat gegevens ingevoerd in 2 werkbladen in excel nou wil ik dat als ik mijn eerste snelkoppeling in toets dat het alles wat het vindt dat ook in de 2e werkblad staat van excel die rij helemaal weg doet.

alvast bedankt
 
hoi

ik zit met het volgende probleem. ik heb een macro die gegevens uit een .txt bestand haalt en dat doet het pas als ik mijn snelkoppelings toets heb ik gedrukt. ik heb wat gegevens ingevoerd in 2 werkbladen in excel nou wil ik dat als ik mijn eerste snelkoppeling in toets dat het alles wat het vindt dat ook in de 2e werkblad staat van excel die rij helemaal weg doet.

alvast bedankt

Wat is een snelkoppelingstoets?

Geef eens de macro die je nu gebruikt, dan kunnen we daarvan vertrekken voor de code. Ook de layout van de Excel bladen moeten we weten om code op te stellen.

Wigi
 
Workbooks.OpenText Filename:="H:\dagrooster\dagrooster.TXT", Origin _
:=437, StartRow:=1, 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), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, _
1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1)), _
TrailingMinusNumbers:=True
Range("A:A,D:D,E:E,P:P,Q:Q,R:R,S:S,N:N").Select
Range("N1").Activate
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Copy
Columns("L:L").Select
ActiveSheet.Paste
Columns("K:K").Select
Application.CutCopyMode = False
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste
Columns("C:D").Select
Selection.Copy
Columns("O:O").Select
ActiveSheet.Paste
Columns("E:F").Select
Application.CutCopyMode = False
Selection.Copy
Columns("C:C").Select
ActiveSheet.Paste
Columns("I:J").Select
Application.CutCopyMode = False
Selection.Copy
Columns("E:E").Select
ActiveSheet.Paste
Columns("P:P").Select
Application.CutCopyMode = False
Selection.Copy
Columns("G:G").Select
ActiveSheet.Paste
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Copy
Columns("H:H").Select
ActiveSheet.Paste
Columns("I:K").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("J:M").Select
Selection.Delete Shift:=xlToLeft
Columns("A:I").Select
Selection.Sort Key1:=Range("I5"), Order1:=xlAscending, _
Key2:=Range("A5"), Order2:=xlAscending, _
Key3:=Range("B5"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A3").Select
ActiveCell.FormulaR1C1 = "klas"
Range("B3").Select
ActiveCell.FormulaR1C1 = "lesuur"
Range("C3").Select
ActiveCell.FormulaR1C1 = "vak"
Range("D3").Select
ActiveCell.FormulaR1C1 = "vak"
Range("E3").Select
ActiveCell.FormulaR1C1 = "lokaal"
Range("F3").Select
ActiveCell.FormulaR1C1 = "lokaal"
Range("G3").Select
ActiveCell.FormulaR1C1 = "invaldocent"
Range("H3").Select
ActiveCell.FormulaR1C1 = "docent"
Range("H3").Select
Columns("G:G").EntireColumn.AutoFit
Range("E3").Select
ActiveCell.FormulaR1C1 = "invallokaal"
Range("D3").Select
ActiveCell.FormulaR1C1 = "invalvak"
Range("A1").Select
ActiveCell.FormulaR1C1 = "ROOSTERWIJZIGING"
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Columns("A:H").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A3:H3").Select
Selection.Font.Bold = True
Selection.ColumnWidth = 11
Range("F3").Select
ActiveCell.FormulaR1C1 = "invallokaal"
Range("E3").Select
ActiveCell.FormulaR1C1 = "lokaal"
Range("G3").Select
Columns("G:G").EntireColumn.AutoFit
End Sub

dit is de macro
een snelkoppelingstoets is welke toets je moet indrukken voordat de macro gestart wordt bijvoorbeeld ctrl+p

groeten
 
Dragon

Je hoeft cellen en kolommen niet te selecteren voor je een bewerking wilt uitvoeren (bv. kopiëren van die cel of kolom of rij). Als er iemand zich geroepen voelt om deze code van de macro recorder op te kuisen, be my guest...
 
Zet ook eens code tags rond je code (de code selecteren en dan op het hekje klikken). Dat leest gemakkelijker.
 
Heb ik de code dan maar wat opgekuist...Wat een karwei! Test ze eens uit op een kopie van het bestand. Verander desnoods wat evt. niet correct is.

Merk je het verschil???

Code:
Sub opgekuisteversie()
Application.ScreenUpdating = False
Workbooks.OpenText Filename:="H:\dagrooster\dagrooster.TXT", Origin:=437, StartRow:=1, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Other:=True, OtherChar:=";", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
    Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), _
    Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1)), TrailingMinusNumbers:=True

Range("A:A,D:D,E:E,P:P,Q:Q,R:R,S:S,N:N").Delete Shift:=xlToLeft
Columns("A").Copy Range("L1")
Columns("K").Cut Range("A1")
Columns("C:D").Copy Range("O1")
Columns("E:F").Copy Range("C1")
Columns("I:J").Copy Range("E1")
Columns("P").Copy Range("G1")
Columns("O").Copy Range("H1")
Columns("I:K").Delete Shift:=xlToLeft
Columns("J:M").Delete Shift:=xlToLeft

Columns("A:I").Sort Key1:=Range("I5"), Order1:=xlAscending, key2:=Range("A5"), Order2:=xlAscending, _
    Key3:=Range("B5"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Rows("1:4").Insert Shift:=xlDown

Range("A1") = "ROOSTERWIJZIGING"
Range("A3") = "klas"
Range("B3") = "lesuur"
Range("C3") = "vak"
Range("D3") = "invalvak"
Range("E3") = "lokaal"
Range("F3") = "invallokaal"
Range("G3") = "invaldocent"
Range("H3") = "docent"

With Cells.Font
    .Name = "Arial"
    .Bold = False
    .Size = 11
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
End With

With Range("A1").Font
    .Bold = True
    .Size = 14
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
End With

With Columns("A:H")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .Orientation = 0
    .ReadingOrder = xlContext
End With

With Range("A1")
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlBottom
    .Orientation = 0
    .ReadingOrder = xlContext
End With

With Range("A3:H3")
    .Font.Bold = True
    .ColumnWidth = 11
End With
Columns("G").AutoFit
Application.ScreenUpdating = True
End Sub

Wigi
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan