Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Zelle löschen und nach oben verschieben

VBA Zelle löschen und nach oben verschieben
16.11.2016 11:33:02
Raimund
Hi All.
Habe folgendes Script.
Vom Blatt Data und Bereich I13:I1000 importiere ich es ins Blatt Verification Bereich Q8:Q1000.
Ferner setze ich auch eine bedingte Formatierung wenn im Blatt Verification und Bereich $K$8:$P$1000 wenn 2 Zellen befüllt sind und entferne ich alle Duplikate.
Nun das Problem.
Im Blatt Data und Bereich I13:I1000 habe ich eine Zelle die mit Sternchen (*************) befüllt ist und diese soll beim Import gelöscht werden und alles was drunter ist im Blatt Verivication und Bereich $K$8:$P$1000 nach oben verschoben werden.
Hoffe auf eine Lösung und bedanke mich im Voraus.
============================
Option Explicit
Sub Import_Verivication()
Dim lngLetzte As Long
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 6)), Cells(Rows.Count, 6).End(xlUp).Row,   _
_
Rows.Count)
Dim Rng2Copy As Range, Rng2Paste As Range
Dim aWerte()
Set Rng2Copy = Sheets("Data").Range("I13:I1000" & lngLetzte)
Set Rng2Paste = Sheets("Verification").Range("Q8:Q1000" & lngLetzte)
aWerte() = Rng2Copy
Rng2Paste = aWerte()
ActiveSheet.Range("Q8:Q1000").RemoveDuplicates Columns:=1 ', Header:=xlYes
Range("$K$8:$P$1000").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=COUNTA($K8:$P8)>=2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("M8").Select
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
VBA Zelle löschen und nach oben verschieben
17.11.2016 13:35:10
Michael
Hi Raimund,
das "VBA gut" würde ich an Deiner Stelle noch einmal überdenken...
a) warum die unterste Zeile von Spalte 6 (F) ermitteln, wenn Spalte 9 (I) kopiert wird?
Die Zeile wird im (ungenannten) ActiveSheet gesucht, aber zum Kopieren aus "Data" verwendet: soll das so sein?
Kopiert wird in "Verification" ab Q8, also auch ohne Berücksichtigung der ermittelten, untersten Zeile.
Was soll nun wohin?
b) gehst Du allen Ernstes davon aus, daß in der untersten Zeile in Spalte F ein Wert steht?
Kann ja sein, aber dann würde ich erst mal eine Fehlermeldung ausspucken, daß da jemand in der Tabelle herumgepfuscht hat.
Denn: Deine zwei "Set" sind verkehrt:
Fall 1: lngLetzte hat irgendeinen "normalen" Wert, sagen wir, 995, dann überlege Dir mal genau, was Du für einen Bereich zuweist:
"I13:I1000" & lngLetzte ergibt nämlich "I13:I1000995"

Ich kann mir nicht vorstellen, daß das erwünscht ist.
Fall 2: lngLetzte ist tatsächlih Rows.Count, dann ergibt das "I13:I10001048576" - das sprengt jede Tabelle!
c)Die zwei Bereiche sind unterschiedlich hoch: I13-I1000 und Q8-1000, das kann nicht hinhauen.
d)Warum überhaupt der Umweg über Set und Kopieren mit Array? Einfacher wäre
Sheets("Data").Range("I13:I" & lngLetzte) Sheets("Verification").Range("Q8")
oder halt ein PasteSpecial...
e)Weiter geht's dann mit aber nicht mit einem konkreten, sondern dem Activesheet - das ist offensichtlich das "Verification", aber wenn das so ist, wieso es dann oben überhaupt angeben?
f)Im Folgenden verwendest Du wieder fix bis Zeile 1000 - hier scheint es angebracht, noch einmal die unterste Zeile zu ermitteln.
Zu Deiner eigentlichen Frage: mir ist unklar, wie es auf dem "Verification" aussieht: Du kopierst nur Werte in Spalte Q, der Rest bleibt unverändert. Das erscheint mir an sich schon komisch, aber ich könnte mir vorstellen, daß da nach unten hin "ausreichend" irgendwelche Formeln stehen, die sich auf Spalte Q beziehen: nun gut.
Aber: wie ist das mit dieser *-Zeile? Soll die nur nicht mitkopiert werden oder soll die komplette Zeile nach dem Import gelöscht werden?
Na egal: suchen nach einem "*" geht, indem man eine Tilde voranstellt, also etwa so:
Sub t()
MsgBox Cells.Find("~*").Address ' nach 1 *
MsgBox Cells.Find("~*~*", Cells(1, 1), xlValues, xlPart).Row ' nach 2 *
End Sub

Die untere Zeile ermittelt die Zeilennummer.
Hier mal ein Schnipsel bis vor die bedingte Formatierung:
Sub IV()
Dim uZact&, uZdata&    ' & = as long, untersteZeile activesheet bzw. data
Dim c As Range
uZact = 8 ' oder Du ermittelst sie dort, falls Daten *unten* angefügt werden sollen
If Sheets("Data").Cells(Rows.Count, 6)  Empty Then MsgBox "nee, glaub ich nicht": Exit Sub
uZdata = Sheets("Data").Cells(Rows.Count, 6).End(xlUp).Row
If uZdata 
Schöne Grüße,
Michael
Anzeige

24 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige