Daten unten anhängen - nur bestimmte

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Daten unten anhängen - nur bestimmte | Herbers Excel-Forum

Daten unten anhängen - nur bestimmte von lutz vom 19.01.2010 10:55:50

AW: Daten unten anhängen - nur bestimmte - von Rudi Maintaire am 19.01.2010 11:43:53
- AW: Daten unten anhängen - nur bestimmte - von lutz am 19.01.2010 11:57:28
  - das steht nicht in meinem Code owT - von Rudi Maintaire am 19.01.2010 12:32:28
    - AW: das steht nicht in meinem Code owT - von jens am 19.01.2010 12:36:54
      - Beispielmappe? owT - von Rudi Maintaire am 19.01.2010 12:52:39
geschlossen - von Rudi Maintaire am 19.01.2010 15:00:05

Betrifft: Daten unten anhängen - nur bestimmte von: lutz
Geschrieben am: 19.01.2010 10:55:50

Hallo Excel-Profis,

ich habe ein Programm bei dem ich Datensätze "buche". Ich erfasse in einem Blatt und übertrage sie dann in ein anderes.

Ich nehme aber nicht alle Datensätze weil nicht immer alle 20 Buchungspositionen bebucht werden - bei denen steht dann "Leersatensatz".

Also übetrage ich erst alles:

Sub ÜbertragenB()
    Application.ScreenUpdating = False
    Sheets("Eingabe").Select
    Range("H3").Select
    Range("W4:BM23").Select
    Selection.Copy
    Sheets("Liste").Select
    Range("A65500").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1:AQ65536").Select
    Application.CutCopyMode = False
        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
       Run Macro:="DeleteLeerdatensatz"
    Sheets("Eingabe").Select
    Range("H3").Select
    Application.ScreenUpdating = True
End Sub

und habe dann eben das Makro "DeleteLeerdatensatz"

Sub DeleteLeerdatensatz()
   Dim var As Variant
   Dim iRow As Integer, iRowL As Integer
   iRowL = Cells(Rows.Count, 1).End(xlUp).Row
   For iRow = iRowL To 1 Step -1
      var = Application.Match("Leerdatensatz", Rows(iRow), 0)
      If Not IsError(var) Then
         Rows(iRow).Delete
      End If
   Next iRow
End Sub

Welches in meinem Blatt "Liste" alle Leerdatensatz-Sätze löscht.

Das ganze geht zwar, ist aber etwas langsam und sicher nicht besonders clever programmiert. Mir ist aber nichts anders eingefallen.

Kennt jemand einen schnelleren Weg?

Vielen Dank Gruß Lutz

Betrifft: AW: Daten unten anhängen - nur bestimmte von: Rudi Maintaire
Geschrieben am: 19.01.2010 11:43:53

Hallo,
teste das mal:

Sub ÜbertragenB()
  Application.ScreenUpdating = False
  With Sheets("Eingabe")
    .Range("W4:BM23").Copy
  End With
  With Sheets("Liste")
    .Range("A65536").End(xlUp).Offset(1).PasteSpecial _
      Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    .Range("A1").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End With
  Run Macro:="DeleteLeerdatensatz"
  Sheets("Eingabe").Select
  Range("H3").Select
  Application.ScreenUpdating = True
End Sub

Sub DeleteLeerdatensatz()
  Dim var As Variant
  Dim iRow As Integer, iRowL As Integer
  Dim rngDel As Range
  With Sheets("Liste")
    iRowL = .Cells(Rows.Count, 1).End(xlUp).Row
    For iRow = iRowL To 1 Step -1
      var = Application.Match("Leerdatensatz", Rows(iRow), 0)
      If Not IsError(var) Then
        If rngDel Is Nothing Then
          Set rngDel = .Cells(iRow, 1)
        Else
          Set rngDel = Union(rngDel, .Cells(iRow, 1))
        End If
      End If
    Next iRow
  End With
  If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Gruß
Rudi

Betrifft: AW: Daten unten anhängen - nur bestimmte von: lutz
Geschrieben am: 19.01.2010 11:57:28

Hallo Rudi,

habe ich mal eingebaut - er steigt aber bei

Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

aus.

Es wäre vielleicht auch am elegantesten, wenn man oben nur die Zeilen nehmen würde in denen nicht "Leerdatensatz" steht, dann könnte man das "DeleteLeerdatensatz" gleich ganz weglassen.

Vielen Dank schon mal

Gruß Lutz

Betrifft: das steht nicht in meinem Code owT von: Rudi Maintaire
Geschrieben am: 19.01.2010 12:32:28

Betrifft: AW: das steht nicht in meinem Code owT von: jens
Geschrieben am: 19.01.2010 12:36:54

Hallo Rudi,

sorry hatte den falschen Bereich markiert - er steigt hier aus:

.Range("A1").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Gruß Lutz