Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1152to1156
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1152to1156
1152to1156
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Code "tunen" / vereinfachen

VBA Code "tunen" / vereinfachen
Mike
Hi Ihr,
folgende Frage an die Experten...: ;-)
Da ich mit VBA leider nicht allzu viel Erfahrung habe, hat mich der folgende Code doch einige Mühen gekostet, liefert aber im Ergebnis genau, was er soll... ;-)
Kann mir hier vielleicht noch jemand ein paar Tricks verraten, wie ich diesen laienhaften Code noch einig entschlacken und damit evtl. auch etwas schneller machen kann ?
Ich glaube, es sieht so weit mehr aus, als es ist... :-) 

Sub Delete_Duplicates()
 Sheets("Duplicates").Select Cells.Select Selection.ClearContents Sheets("New").Select Cells.Select Selection.ClearContents Sheets("All").Select Columns("A:H").Select Selection.ClearContents Sheets("Import").Select Columns("B:H").Select Selection.Copy Sheets("All").Select Columns("B:H").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("Import").Select Columns("A:A").Select Selection.Copy Sheets("All").Select Columns("A:A").Select ActiveSheet.Paste Sheets("Import").Select Columns("D:D").Select Selection.Copy Sheets("All").Select Columns("D:D").Select ActiveSheet.Paste Columns("L:L").Select Application.CutCopyMode = False Selection.Copy Columns("A:A").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Selection.NumberFormat = "d/m/yyyy" Selection.ColumnWidth = 12.14 Columns("M:M").Select Application.CutCopyMode = False Selection.Copy Columns("D:D").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Selection.NumberFormat = "d/m/yyyy" Selection.ColumnWidth = 12.14 Columns("A:A").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .MergeCells = False .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .MergeCells = False End With Columns("D:D").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .MergeCells = False .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .MergeCells = False End With Sheets("All").Select Cells.Select Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("F1") _ , Order2:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False _ , Orientation:=xlTopToBottom Rows("1:1").Select Selection.EntireRow.Insert Cells.Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:="=" Cells.Select Selection.Copy Sheets("New").Select Range("A1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Rows("1:1").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp Sheets("All").Select Selection.AutoFilter Field:=9, Criteria1:="duplicate" Cells.Select Selection.Copy Sheets("Duplicates").Select Range("A1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Rows("1:1").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp Sheets("All").Select Selection.AutoFilter Field:=9 Selection.AutoFilter Rows("1:1").Select Selection.Delete Shift:=xlUp Range("A1").Select Sheets("Import").Select Range("A1").Select Sheets("New").Select Range("A1").Select Sheets("Duplicates").Select Range("A1").Select Sheets("Report").Select Range("A1").Select End Sub
VG u. vielen Dank Euch für jeden Tipp,
Mike
AW: AW:erstmal die selects entfernen
21.04.2010 23:13:24
Mike
Hi Daniel,
danke für den Tipp - das mache ich gerne.
Hier geht es mir aber jetzt ganz konkret um diesen Code und da muss ich etwas finden, bevor ich Zeit zum Lesen habe...
VG,
Mike
AW: AW:erstmal die selects entfernen
21.04.2010 23:22:27
Daniel
HI
wenn du erstmal die überflüssigen Selects entfernt hast (und darum geht es in dem Beitrag), wird der Code schon mal viel schneller und vorallem viel kürzer.
dann ist es wesentlich einfacher, sich um die Inhalte zu kümmern.
so ist es viel zu anstrengend, den Code zu lesen.
Gruß, Daniel
Anzeige
sorry war der letzte Beitrag war nicht passend
21.04.2010 23:31:35
Daniel
AW: VBA Code "tunen" / vereinfachen
21.04.2010 23:22:13
Josef

Hallo Mike,
ich hoffe, das ich nichts übersehen habe.

Sub Delete_Duplicates()
  
  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  
  Sheets("Duplicates").Cells.ClearContents
  Sheets("New").Cells.ClearContents
  
  With Sheets("All")
    .Columns("A:H").ClearContents
    .Columns("B:H") = Sheets("Import").Columns("B:H").Value
    Sheets("Import").Columns("A:A").Copy .Columns("A:A")
    Sheets("Import").Columns("D:D").Copy .Columns("D:D")
    .Columns("A:A") = .Columns("L:L").Value
    .Columns("A:A").NumberFormat = "d/m/yyyy"
    .Columns("A:A").ColumnWidth = 12.14
    .Columns("D:D") = Columns("M:M").Value
    .Columns("D:D").NumberFormat = "d/m/yyyy"
    .Columns("D:D").ColumnWidth = 12.14
    With .Columns("A:A")
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlBottom
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .MergeCells = False
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlTop
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .MergeCells = False
    End With
    With .Columns("D:D")
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlBottom
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .MergeCells = False
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlTop
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .MergeCells = False
    End With
    .Cells.Sort Key1:=.Range("B1"), Order1:=xlAscending, Key2:=.Range("F1") _
      , Order2:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False _
      , Orientation:=xlTopToBottom
    .Rows("1:1").Insert
    .Cells.AutoFilter
    .Cells.AutoFilter Field:=9, Criteria1:="="
    .Cells.Copy
    Sheets("New").Range("A1").PasteSpecial Paste:=xlValues
    Sheets("New").Rows("1:1").Delete Shift:=xlUp
    .Cells.AutoFilter Field:=9, Criteria1:="duplicate"
    .Cells.Copy
    Sheets("Duplicates").Range("A1").PasteSpecial Paste:=xlValues
    Sheets("Duplicates").Rows("1:1").Delete Shift:=xlUp
    .Cells.AutoFilter
    .Rows("1:1").Delete Shift:=xlUp
    .Range("A1").Select
  End With
  
  Sheets("Import").Select
  Range("A1").Select
  
  Sheets("New").Select
  Range("A1").Select
  
  Sheets("Duplicates").Select
  Range("A1").Select
  
  Sheets("Report").Select
  Range("A1").Select
  
  ErrExit:
  Application.ScreenUpdating = True
  If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
End Sub


Gruß Sepp

Anzeige
AW: VBA Code "tunen" / vereinfachen
21.04.2010 23:32:40
Mike
Hallo Sepp,
wow, sieht ja klasse aus ! :-)
Hier erhalte ich jedoch die folgende Fehlermeldung:
1004. Die Select-Methode des Range-Objektes konnte nicht ausgeführt werden.
VG, Mike
ich möchte nur Sepp helfen...
22.04.2010 08:26:54
Oberschlumpf
...hallo Mike
Glaubst du wirklich, Sepp hat ne Glaskugel?
Warum schreibst du zu der Fehlermeldung nicht gleich auch die Zeile mit dazu, in der der Fehler auftritt?
Ja, vielleicht willst du jetzt mit dem Text antworten "Ja, aber Sepp hat den Code doch auch! Er braucht ihn doch nur zu starten, dann sieht er, wo der Fehler auftritt."
Trotzdem!
Schreib doch bitte die Fehler-Zeile mit auf.
So weiß jeder sofort - ohne noch testen zu müssen - wo der Fehler ist.
Die Antworter "opfern" für die Fragenden doch schon ne Menge Zeit, die die Fragenden nix kostet.
Da kann man den Antwortenden schon mal n bisschen mehr helfen!
Ciao
Thorsten
Anzeige
AW: ich möchte nur Sepp helfen...
22.04.2010 21:30:11
Mike
@ Thorsten
Danke für den schwachen Kommentar !
Wer sowas schreibt, hat offensichtlich zu viel Zeit...
Wenn ich mehr Kenntnisse mit VBA hätte, würde ich auch meine Fragen anders formulieren oder vermutlich gar nicht erst stellen - aber wahrscheinlich brauchen das manche für ihr Ego...
Also, danke für nichts !
M.
AW: ich möchte nur Sepp helfen...
22.04.2010 21:56:01
Josef

Hallo Mike,
Thorsten hat schon Recht, wenn schon ein Fehler auftritt, dann sollte man wenigstens angeben, in welcher Zeile er erscheint!
Ich hatte ja geschrieben "ich hoffe, das ich nichts übersehen habe"
Oder glaubst du, ich baue deine Datei nach?
So sollte es laufen.

Sub Delete_Duplicates()
  
  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  
  Sheets("Duplicates").Cells.ClearContents
  Sheets("New").Cells.ClearContents
  
  With Sheets("All")
    .Columns("A:H").ClearContents
    .Columns("B:H") = Sheets("Import").Columns("B:H").Value
    Sheets("Import").Columns("A:A").Copy .Columns("A:A")
    Sheets("Import").Columns("D:D").Copy .Columns("D:D")
    .Columns("A:A") = .Columns("L:L").Value
    .Columns("D:D") = Columns("M:M").Value
    With .Range("A:A, D:D")
      .NumberFormat = "d/m/yyyy"
      .ColumnWidth = 12.14
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlTop
      .WrapText = True
    End With
    .Cells.Sort Key1:=.Range("B1"), Order1:=xlAscending, Key2:=.Range("F1") _
      , Order2:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False _
      , Orientation:=xlTopToBottom
    .Rows("1:1").Insert
    .Cells.AutoFilter
    .Cells.AutoFilter Field:=9, Criteria1:="="
    .Cells.Copy
    Sheets("New").Range("A1").PasteSpecial Paste:=xlValues
    Sheets("New").Rows("1:1").Delete Shift:=xlUp
    .Cells.AutoFilter Field:=9, Criteria1:="duplicate"
    .Cells.Copy
    Sheets("Duplicates").Range("A1").PasteSpecial Paste:=xlValues
    Sheets("Duplicates").Rows("1:1").Delete Shift:=xlUp
    .Cells.AutoFilter
    .Rows("1:1").Delete Shift:=xlUp
    .Activate
    .Range("A1").Select
  End With
  
  Sheets("Import").Activate
  Range("A1").Select
  
  Sheets("New").Activate
  Range("A1").Select
  
  Sheets("Duplicates").Activate
  Range("A1").Select
  
  Sheets("Report").Activate
  Range("A1").Select
  
  ErrExit:
  Application.ScreenUpdating = True
  If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
End Sub

Gruß Sepp

Anzeige

300 Forumthreads zu ähnlichen Themen

VBA-Code auf Smartphone mit Windwos Mobil 6
Thorsten

Hallo zusammen,
kann mir jemand von Euch sagen, ob Makros (VBA) jetzt auf den smartphones mit Windows mobil 6.0 oder 6.1 laufen.
Ich suche dringend eine Möglichkeit, meine Exceltabellen incl. der VBA-Makros auf einem kleinen Mobilen Gerät auszuführen (Smartphone, PDA oder ähnl.), konnte...
24.09.2008 14:45:36
Thread-ID: 1012076
2 Beiträge
Anzeige
VBA Code: wenn B1 <> blank, dann I in A1 schreiben
maxx_1985

Hi mit'nander
Braeuchte einen kleine Code dafuer:
wenn B1 blank, dann schreibe ein I in A1.
kann mir vielleicht jemand helfen? :-)
vielen vielen dank
denis
18.11.2008 16:27:16
Thread-ID: 1025694
5 Beiträge
wo VBA code einfuegen? ins modul?
maxx_1985

Hey Leute,
wo muss ich diesen Code einfuegen, damit er funktioniert? doch in kein modul oder?
Private Sub Open_workbook() Const Blattname = "Overview" Dim z As Range With Sheets(Blattname) .Activate Set z = .Range("a:a").Find(What:="=Tue", LookIn:=xlFormulas) If Not z Is Nothing Then...
03.12.2008 16:10:39
Thread-ID: 1029882
10 Beiträge
Anzeige
VBA-Code in einem String erzeugen und dann ausführ
Dirk

Hallo!
Gibt es eine Möglichkeit, VBA-Code auszuführen, der in einer String-Variablen vorliegt, die zuvor dynamisch erzeugt wurde? Sprich: Ich möchte VBA-Code dynamisch erzeugen und anschließend ausführen. Geht das irgendwie?
Ich hoffe, das ist so verständlich.
Vielen Dank,
Dirk<...
20.01.2009 20:08:36
Thread-ID: 1041981
4 Beiträge
VBA Code mit VBA in Tabelle kopieren - Fehler?!
Andreas

Hallo Herber Fans,
ich habe mir heute aus der Recherche eine Möglichkeit rausgesucht, einen Code über VBA in ein anderes VBA Worksheet zu kopieren. Das dies in VBA überhaupt geht ist ja schon genial. Es soll ein Code in das VBA Worksheet des activeworkbooks kopiert werden.
Der Code dafü...
11.02.2009 15:56:00
Thread-ID: 1049657
3 Beiträge
VBA-Code für "Suchen in: Formeln"
Wolfango

Hallo Experten,
ich habe folgenden VBA-Code:
Sub nach_DokNr_suchen() Columns("A:A").Select Application.Dialogs(xlDialogFormulaFind).Show End Sub
Leider habe ich von VBA keine Ahnung!!!
Wie muss ich diesen Code ergänzen bzw. erweitern, dass im erscheinenden "Suchen-Dialogfeld...
20.04.2009 14:58:48
Thread-ID: 1069849
5 Beiträge
Schutz von VBA-Codes in Excel
VBA-Codes

Mal eine Frage an die Excel-Profis unter Euch. ;)
Habe nach einer Möglichkeit gesucht für eine umfangreichere VBA-Arbeit meine Codes zu schützen, da Excel selber ja nur rudimentären Schutz bietet der von jedem der sich ein wenig besser auskennt in Sekunden auszuhebeln ist.
Dabei bin ich...
22.04.2009 11:22:36
Thread-ID: 1070279
6 Beiträge
Beim erstellen Tabellenblatt VBA Code eintragen | Herbers Excel-Forum
Robert
Guten morgen Leute,
wer kann mit helfen?
Ich möchte per VBA Code in dem neuer erstellten Tabellenblatt mit Namen XY einen Quellcode
reinschreiben z.b.
in einer Spalte AF addiere Zellen wenn die eine Zahl enthalten.
Mit dank im Voraus
Robert
23.05.2009 09:00:32
Thread-ID: 1076816
22 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
1
4
4
9
6
3
2
4
5
21
2
5
3
12
2
4
6
5
8
8
4
6
4
1
2