Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1368to1372
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bitte um Hilfe für Range statt Select

Bitte um Hilfe für Range statt Select
20.07.2014 08:40:49
Andreas

  • Liebe Forumsgemeinde,
    als VBA-Neuling und das im „Eigenstudium“ benötige ich bitte eure Hilfe. Wiederholt habe ich schon gelesen, dass man möglichst auf SELECT verzichten und stattdessen RANGE verwenden sollte, ich bekomme das aber nicht gebacken und habe mittels Makrorecorder und leichten Abwandlungen den nachstehenden Code erstellt. Jedoch besteht bei Ausführung der Routine auf dem Monitor ein sichtbares Flimmern. Wie müsste der Code aussehen, dass die Bildstörungen bzw. das verzögerte Abarbeiten des VBA nicht entsteht.
    Vielen Dank schon jetzt für die Hilfeleistung und noch einen schönen Sonntag.
    Andreas
    Option Explicit
    
    Sub Makro5()
    ' Makro5 Makro
    ' Tastenkombination: Strg+j
    Range("A8:A1600, b8:b1600, c8:c1600, d8:d1600").Select
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("A:A") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("A1:A1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$A$1:$A$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveWindow.SmallScroll Down:=-3
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("b:b") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("b1:b1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$b$1:$b$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveWindow.SmallScroll Down:=-3
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("c:c") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("c1:c1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$c$1:$c$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveWindow.SmallScroll Down:=-3
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("d:d") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("d1:d1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$d$1:$d$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveWindow.SmallScroll Down:=-3
    Range("A2:z800").Select
    Selection.Cut
    Range("A3").Select
    ActiveSheet.Paste
    Range("g1").Select
    End Sub
    

    4
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Bitte um Hilfe für Range statt Select
    20.07.2014 09:45:15
    Hajo_Zi
    Du hast ja wenige select
    Option Explicit
    Sub Makro5()
    ' Makro5 Makro
    ' Tastenkombination: Strg+j
    Range("A8:A1600, b8:b1600, c8:c1600, d8:d1600").Copy _
    Sheets("Tabelle3").Range("A1")
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("A:A") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("A1:A1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$A$1:$A$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("b:b") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("b1:b1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$b$1:$b$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("c:c") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("c1:c1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$c$1:$c$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle3").Sort.SortFields.Add Key:=Range("d:d") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle3").Sort
    .SetRange Range("d1:d1900")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$d$1:$d$1900").RemoveDuplicates Columns:=1, Header:=xlYes
    Range("A2:z800").Cut Range("A3")
    End Sub
    

    Anzeige
    AW: Bitte um Hilfe für Range statt Select
    20.07.2014 19:00:27
    Adis
    Hallo
    es lohnt ich hier nur die Select wegzulassen wo nachher Selection.Copy oder Cut steht
    Da kann man das Select im Range().Select Text direkt durch Copy oder Cut ersetzen.

    AW: Bitte um Hilfe für Range statt Select
    21.07.2014 18:00:14
    Andreas
    Vielen Dank für die Hilfestellungen und ganz speziell an Hajo, er ist echt der Hammer.

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige