Office: (Office 2010) VBA

Hallo,

ich habe ein Problem:

Ich möchte gerne ein Tabellenblatt mit einem Makro bearbeiten. Dort sind mehrere hundert Daten vorhanden.
Wenn in Spalte A kein Wert steht, dann sollen die Zeilen A-Q gelöscht werden (Spalte R etc. werden noch benötigt) und zudem sollen die restlichen Zeilen nach oben aufrücken.

Leider bekomme ich das nicht so recht hin. Dies ist mein bisheriger Versuch:


Dim rng As Range
On Error Resume Next
Set rng = Sheets("Tabelle1").Range("A5:A1000").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.delete
Set rng = Nothing


Der Code soll aber nicht die ganze Zeile löschen, sondern nur den Inhalt der betreffenden Zellen (A-Q), da ich die hinteren Spalten noch brauche.
Wie kann ich also "entireRow" eingrenzen auf bestimmte Zellen und gleichzeitig dafür sorgen, dass der Rest hochrutscht?

Vielen Dank schonmal :-)

Torsten

:)

 

Hallo Torsten,

so?
Code:

Grüße
EarlFred

 

Passt super, vielen Dank für die schnelle Hilfe :-)

 

Hallo Torsten,

Schau dir mal=intersect() an.

Option Explicit

Sub machs()
Dim rng As Range
Dim rngToDelete As Range
On Error Resume Next
Set rng = Sheets("Tabelle1").Range("A5:A1000").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
Set rngToDelete = Intersect(rng.EntireRow, Range("A1:Q1000"))
rngToDelete.Delete shift:=xlUp
Set rng = Nothing
End If
End Sub


ransi

 

Hallo EarlFred,

ein kleines Problem besteht doch noch:

Ich habe in den hinteren Spalten (ab Spalte R) Wenn-Funktionen stehen, die sich auf die Spalten A-Q teilweise beziehen (um Werte zu verketten).
Leider geht bei diesen der Bezug verloren, wenn ich die Makro-Funktion anwende.

Am besten wäre es, wenn die übrig gebliebenen Zeilen nach oben rutschen und die Wenn-Funktionen ab Spalte R weiterhin funktionieren würden.

Hast du dafür ne Lösung?

Gruß Torsten

 

Hallo Torsten

anstelle (z. B.)
Code:

verwendest Du:
Code:

(solange sich die Formel auf die gleiche Zeile beziehen soll, in der sie selbst steht)

Grüße
EarlFred

 

Nochmals Danke...hat auch geholfen :-)

Gruß Torsten

 

Hallo,

leider gibt es wieder ein Problem.

Jetzt sollen die gefundenen Werte nicht mehr gelöscht werden, sondern in einen neuen Tabellenreiter kopiert werden.

Da dachte ich mir folgendes (in Bezug auf den vorherigen Code):



Dim gefunden As Range
Zeile_Suche = 5

Do
Set gefunden = Worksheets("Historie").Columns(18).Find(what:=Worksheets("neue Daten").Cells(Zeile_Suche, 18), LookIn:=xlValues, lookat:=xlWhole)

If Not gefunden Is Nothing Then
Intersect(gefunden.EntireRow, Worksheets("neue Daten").Range("A:Q")).copy
Worksheets("gelöscht").Range("A:Q").PasteSpecial Paste:=xlValues
Zeile_Suche = Zeile_Suche + 1

Else
Zeile_Suche = Zeile_Suche + 1

End If

Loop Until Zeile_Suche = 200



Leider meckert Excel da immer: "Methode 'Intersect' für das Objekt '_Global' ist fehlgeschlagen.

Ich möchte einfach nur, dass wenn ein neuer Wert übereinstimmt mit der Historie, dass dann die Spalten A:Q der gefundenen Zeile in einen neuen Reiter kopiert werden.

Kann mir noch wer helfen?

Beste Grüße Torsten

 

Hallo Torsten,


Code:

Der eine Bereich bezieht sich auf das Worksheet "Historie", der andere auf das Worksheet "neue Daten". Aus diesen Bereichen kannst Du keine Schnittmenge bilden.

Hast Du ransis Antwort übersehen, oder warum ist sie Dir nichtmal ein kleines "Dankeschön" wert? Hat ihm sicher auch Arbeit gemacht.

Grüße
EarlFred

 

Danke für den Hinweis...jetzt läufts erstmal...bis der nächste Änderungswunsch kommt ;-)

...und natürlich auch vielen Dank an ransis, das hatte ich leider vergessen *rolleyes.gif* *frown.gif*

Viele Grüße
Torsten