[VBA / Excel 2007] hoe dynamische range gebruiken? *

Pagina: 1
Acties:

Onderwerpen


Acties:
  • 0 Henk 'm!

  • Mastha-Hacker
  • Registratie: Mei 2009
  • Laatst online: 02-12-2024
Hi,

Ik ben bezig om een macro te schrijven voor het sorteren, uitzoeken en splitsen van data te automatiseren. Ik loop nu alleen tegen het probleem aan dat ik alleen een vaste range kan selecteren. Weet iemand hier hoe ik alle cellen tegelijk kan selecteren voor sorting, copy and pasting?
Ik heb geprobeerd om de Range te vervangen door "Cells", alleen geeft excel een foutmelding 1004, waar verder geen informatie bij vermeld wordt.

En volgens mij zit er ook heel wat overbodige code in, die het geheel trager maken...

Hieronder is mijn huidige macro:

Visual Basic .NET:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
Sub ImportData()
' Clearing of all sheets
    Sheets("Fase250").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("Fase300").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("Fase400").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    
    Sheets("Imported").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
' Importing data.txt from same directory and pasting it on sheet: Imported
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;S:\Planning\johan\data.txt", Destination:=Range("$A$1"))
        .Name = "data_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 4
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(2, 2, 2, 1, 1, 2, 2, 4, 9, 9, 4)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
' Changing format of column
    Columns("I:I").Select
    Selection.NumberFormat = "m/d/yyyy"
    ActiveWindow.ScrollColumn = 1
    Cells.Select
' Sorting whole sheet for splitting phases.
    ActiveWorkbook.Worksheets("Imported").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Imported").Sort.SortFields.Add Key:=Range( _
        "D2:D356"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Imported").Sort
        .SetRange Range("A1:V356")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$V$356").AutoFilter Field:=4, Criteria1:="250"
    Range("A1:I356").Select
    Range("A28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Fase250").Select
    ActiveSheet.Paste
    Sheets("Imported").Select
    ActiveSheet.Range("$A$1:$V$356").AutoFilter Field:=4, Criteria1:="300"
    Range("A1:I356").Select
    Range("A28").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Fase300").Select
    ActiveSheet.Paste
    Sheets("Imported").Select
    Range("F27").Select
    ActiveSheet.Range("$A$1:$V$356").AutoFilter Field:=4, Criteria1:="400"
    Range("B268").Select
    ActiveWindow.ScrollColumn = 1
    Range("A1:I356").Select
    Range("B268").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Fase400").Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Sheets("Imported").Select
    ActiveSheet.Range("$A$1:$V$356").AutoFilter Field:=4
    Sheets("Fase400").Select
    
    ActiveWorkbook.Worksheets("Fase400").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Fase400").Sort.SortFields.Add Key:=Range("I2:I92") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Fase400").Sort
        .SetRange Range("A1:I92")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Fase300").Select
    ActiveWorkbook.Worksheets("Fase300").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Fase300").Sort.SortFields.Add Key:=Range("I2:I242" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Fase300").Sort
        .SetRange Range("A1:I242")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Home").Select
End Sub

[ Voor 1% gewijzigd door Mastha-Hacker op 08-06-2011 11:08 . Reden: Comments toegevoegd. ]


Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Topictitel afgemaakt, was: '[VBA / Excel 2007]'.

Inderdaad erg veel overbodige code, volgens mij kan het af met 5 tot 10x zo weinig regels code. Ik zou aanraden niet uit te gaan van 'opgenomen' code maar de code zelf te schrijven. En dan nooit .Select te gebruiken, maar misschien is dat een 'pet peeve' van me.


Maar ik begrijp niet waar nu precies je vraag zit; wat lukt niet / wat wil je dynamisch hebben? Ik gok dat je op zoek bent naar %bereik%.end(xldown)

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

  • Mastha-Hacker
  • Registratie: Mei 2009
  • Laatst online: 02-12-2024
Hi,

Het probleem is dat dit mijn eerste een laatste macro voor excel is die ik moet maken. Ik heb dus gewoon wat geprobeerd, en toen kwam ik op ongeveer het bovenstaande uit. En met mijn kennis kon ik de code nog wel enigzins cleanen. Ik heb alleen geen idee welke code excel belangrijk vindt en welke niet. Dus elke opmerking is welkom! :)

Verder ben ik dus opzoek naar een variabele die alle ingevulde cellen van het sheet pakt. Nu mis ik namelijk informatie, omdat ik nu statische cellen heb (A01 tot I356).

Acties:
  • 0 Henk 'm!

  • Mastha-Hacker
  • Registratie: Mei 2009
  • Laatst online: 02-12-2024
Is er iemand die mij hier mee kan helpen??

Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

offtopic:
Als eenmalig dan moet je dit helemaal niet met een macro gaan doen maar gewoon met de hand :) En eenmalige een macro om er nooit meer mee wat te willen doen zou ik ook niet aanraden. Je wilt weten wat er precies met je data gebeurt.


Om een heel bereik te vinden: bijv. http://www.ozgrid.com/VBA/ExcelRanges.htm geeft een voorbeeld. Of [google=excel vba select all cells with data] => Macro to Select all Data on a Worksheet

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

  • Mastha-Hacker
  • Registratie: Mei 2009
  • Laatst online: 02-12-2024
F_J_K schreef op dinsdag 14 juni 2011 @ 07:57:
offtopic:
Als eenmalig dan moet je dit helemaal niet met een macro gaan doen maar gewoon met de hand :) En eenmalige een macro om er nooit meer mee wat te willen doen zou ik ook niet aanraden. Je wilt weten wat er precies met je data gebeurt.


Om een heel bereik te vinden: bijv. http://www.ozgrid.com/VBA/ExcelRanges.htm geeft een voorbeeld. Of [google=excel vba select all cells with data] => Macro to Select all Data on a Worksheet
Thnx! Ik ga er zo naar kijken.
En de macro moet elke week gebruikt gaan worden door mijn leidinggevende, maar dit is de eerste en laatste keer dat ik uberhaupt een macro moet/ga maken..

[EDIT]
De macro loopt vast op dit stukje:
Visual Basic .NET:
1
2
3
4
5
6
7
8
9
10
11
    ActiveWorkbook.Worksheets("Imported").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Imported").Sort.SortFields.Add Key:=Range(Selection, Selection.SpecialCells(xlLastCell)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Imported").Sort
        .SetRange Range(Selection, Selection.SpecialCells(xlLastCell))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


Excel geeft fout 1004 op de .Apply..

[ Voor 29% gewijzigd door Mastha-Hacker op 14-06-2011 11:38 . Reden: Tested, but failed. Results added.. ]


Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Het probleem is hier de .SortFields.Add Key dat is waar (op welke kolom/welk veld) je sorteert en dat gaat nu dus fout - en dus weet Excel niet hoe te sorteren als je .Apply doet.

Geef de juiste velden op waarop je wilt sorteren. Dat kan je waarschijnlijk gewoon hardcoded doen, voldoet Key:=ActiveSheet.Cells(1, 1) niet al?

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

  • Mastha-Hacker
  • Registratie: Mei 2009
  • Laatst online: 02-12-2024
Het is gelukt! Ik moest de rang("a1") er nog boven zetten.

Acties:
  • 0 Henk 'm!

  • Mastha-Hacker
  • Registratie: Mei 2009
  • Laatst online: 02-12-2024
Working version:
Visual Basic .NET:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
Sub ImportData()

    Dim fn
    fn = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If fn = False Then
    MsgBox "Geen bestand gekozen, of verkeerde extensie geselecteerd!"
    Else
    
        Sheets("Fase250").Select
        Cells.Select
        Selection.ClearContents
        Range("A1").Select
        Sheets("Fase300").Select
        Cells.Select
        Selection.ClearContents
        Range("A1").Select
        Sheets("Fase400").Select
        Cells.Select
        Selection.ClearContents
        Range("A1").Select
        Sheets("Imported").Select
        Cells.Select
        Selection.ClearContents
        Range("A1").Select
        
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & fn, Destination:=Range("$A$1"))
            .Name = "data_1"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 4
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "|"
            .TextFileColumnDataTypes = Array(2, 2, 2, 1, 1, 2, 2, 4, 9, 9, 4)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Columns("I:I").Select
        Selection.NumberFormat = "m/d/yyyy"
        Cells.Select
        ActiveWorkbook.Worksheets("Imported").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Imported").Sort.SortFields.Add Key:=Range("D2").End(xlDown), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Imported").Sort
            .SetRange Range(Selection, Selection.SpecialCells(xlLastCell))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Selection.AutoFilter
        
        Range("A1").Select
        ActiveSheet.Range(Selection, Selection.SpecialCells(xlLastCell)).AutoFilter Field:=4, Criteria1:="250"
        Range(Selection, Selection.SpecialCells(xlLastCell)).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Fase250").Select
        ActiveSheet.Paste
        
        Sheets("Imported").Select
        Range("A1").Select
        ActiveSheet.Range(Selection, Selection.SpecialCells(xlLastCell)).AutoFilter Field:=4, Criteria1:="300"
        Range(Selection, Selection.SpecialCells(xlLastCell)).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Fase300").Select
        ActiveSheet.Paste
        
        Sheets("Imported").Select
        Range("A1").Select
        ActiveSheet.Range(Selection, Selection.SpecialCells(xlLastCell)).AutoFilter Field:=4, Criteria1:="400"
        Range(Selection, Selection.SpecialCells(xlLastCell)).Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Fase400").Select
        ActiveSheet.Paste
        
        Sheets("Imported").Select
        ActiveSheet.Range(Selection, Selection.SpecialCells(xlLastCell)).AutoFilter Field:=4
        
        Sheets("Fase250").Select
        ActiveWorkbook.Worksheets("Fase250").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Fase250").Sort.SortFields.Add Key:=Range("I2").End(xlDown), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Fase250").Sort
            .SetRange Range(Selection, Selection.SpecialCells(xlLastCell))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Selection.AutoFilter
        
        Sheets("Fase300").Select
        ActiveWorkbook.Worksheets("Fase300").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Fase300").Sort.SortFields.Add Key:=Range("I2").End(xlDown), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Fase300").Sort
            .SetRange Range(Selection, Selection.SpecialCells(xlLastCell))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Selection.AutoFilter
        
        Sheets("Fase400").Select
        ActiveWorkbook.Worksheets("Fase400").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Fase400").Sort.SortFields.Add Key:=Range("I2").End(xlDown), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Fase400").Sort
            .SetRange Range(Selection, Selection.SpecialCells(xlLastCell))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Selection.AutoFilter
        
        Sheets("Home").Select
    
    End If
End Sub
Pagina: 1