Hallo!
Ich hoffe ihr könnt mir mal wieder helfen.
Ich habe eine Tabelle (tbl_base) die von A:Q befüllt ist.
In Q wird die jeweilige Versionsnummer der Spalten definiert.
Hier soll die höchste Nummer bestimmt werden und alle Spalten, die einen Wert drunter haben, sollen gelöscht werden.
Entsprechend sollen alle Spalten nach oben rutschen, fall die obere gelöscht wurde.
Wie kriege ich das genau hin, mit VBA?
Kann ich vor der If Schleife einer Variable definieren, die den höchsten Wert von Spalte Q ermittelt?
Entsprechend löscht dann die If Schleife alle Werte dadrunter.
Oder Wie würdet ihr da rangehen?
so ganz habe ich die Frage nicht verstanden. Kannst du einmal eine Beispieldatei hochladen. Ein Blatt mit den Ausgangsdaten in dem du die zu vergleichenden Werte markierst. Und ein Blatt mit dem gewünschten Ergebnis.
Für mein Verständnis :
a) könnenSpalten nicht nach oben rutschen, sondern nur Zeilen.
b) gibt es keine IF-Schleifen, sondern If-Verzweigungen und For-Schleifen.
helmut
Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität. Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
Ich habe eine Tabelle wo in Spalte Q die Version steht.
Hier soll die höchste Zahl ermittelt werden und alle Zeilen, die einen Wert unter dieser Zahl haben, sollen gelöscht werden. Dabei sollen die restlichen Zeilen jeweils nach oben rutschen.
Private Sub cbLoeschen_Click()
Dim varDaten As Variant
Dim strRange As String
Dim lngSpalte As Long
Dim lngAltZeile As Long
Dim lngNeuZeile As Long
Dim lngAnzZeilen As Long
Dim lngAnzSpalten As Long
Dim dblAktMax As Double
Dim dblAktWert As Double
Const intWertSpalte As Integer = 17
For lngAltZeile = 1 To lngAnzZeilen
dblAktWert = varDaten(lngAltZeile, intWertSpalte)
If dblAktWert >= dblAktMax Then
If dblAktWert = dblAktMax Then
lngNeuZeile = lngNeuZeile + 1
Else
lngNeuZeile = 1
dblAktMax = dblAktWert
End If
For lngSpalte = 1 To lngAnzSpalten
varDaten(lngNeuZeile, lngSpalte) = varDaten(lngAltZeile, lngSpalte)
Next lngSpalte
End If
Next lngAltZeile
For lngAltZeile = lngNeuZeile + 1 To lngAnzZeilen
For lngSpalte = 1 To lngAnzSpalten
varDaten(lngAltZeile, lngSpalte) = ""
Next lngSpalte
Next lngAltZeile
Range(strRange).Value = varDaten
End Sub
helmut
Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität. Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
Folgende(r) 1 Nutzer sagt Danke an Ego für diesen Beitrag:1 Nutzer sagt Danke an Ego für diesen Beitrag 28 • joshua
19.01.2017, 10:58 (Dieser Beitrag wurde zuletzt bearbeitet: 19.01.2017, 11:18 von atilla.)
Hallo,
wenn es unbedingt per VBA gehen soll, dann ginge folgendes:
Code:
Sub ati()
Dim i As Long, j As Long, k As Long
Dim lngMax As Long
Dim lngAnzahlm As Long
Dim feld
Dim arr()
With Sheets("Tabelle1")
lngMax = Application.Max(.Columns("Q"))
lngAnzahlm = Application.CountIf(.Columns("Q"), lngMax)
feld = .Range("A2").CurrentRegion
ReDim arr(lngAnzahlm - 1, 16)
For i = 0 To .Range("A2").CurrentRegion.Rows.Count - 1
If feld(i + 1, 17) = lngMax Then
For j = 0 To 16
arr(k, j) = feld(i + 1, j + 1)
Next j
k = k + 1
End If
Next i
.Range("A2").CurrentRegion.ClearContents
.Range("A2:Q" & 2 + k - 1) = arr
End With
End Sub
Die Prozedur kann aus jeder anderen Prozedur mit "Call ati" oder nur "ati" aufgerufen werden.
Es ist auch möglich die Original Tabelle beizubehalten und die gefilterten Werte in eine andere Tabelle zu schreiben.
Dazu müssen nur die letzten zwei Zeilen im Code angepasst werden.
snb's Code macht nicht das, was Du möchtest.
Er sucht den ersten Treffer und schreibt diesen in Zeile 30. Also immer nur eine Zeile.
Wie unten ergänzt, würde der Code in einer nach Spalte Q sortierten Liste alle Treffer ab Zeile 30 schreiben:
Code:
Sub M_snb()
Dim x As Long
x = Application.CountIf(Columns("Q"), [max(Q1:Q200)])
Cells(30, 1).Resize(x, 17) = Range("A1:Q1").Offset([match(max(Q1:Q200),Q1:Q200,0)] - 1).Resize(x, 17).Value
End Sub
a) zu deiner Frage:
Wenn du den code in ein WorkbookOpen Makro einbauen willst must du wie in atillas Code
1. nach der Deklaration ein "With Sheets()" und vor dem Ende ein "End With" einbauen und
2. vor jedem Range-Objekt eine Punkt setzen.
b) Generell solltest du einen code, den du nicht verstanden hast, oder der dir nicht genau erklärt wurde, insbesondere wenn er Daten löscht oder verändert nicht einfach übernehmen.
Hier einmal ein Vergleich der beiden VBA Vorschläge:
1) Beide Vorschläge löschen keine Zeilen, sondern schreiben nur die Zeilen mit den Maximalwerten nach oben und löschen den Inhalt der unteren Zeilen.
Wenn du Zeilen -warum auch immer- unterschiedlich formatierst, werden diese Formate nicht mitgenommen.
2) In attilas Beispiel werden die ersten 17 Spalten berücksichtigt, in meinem Beispiel alle genutzten Spalten.
Falls neben deiner Liste noch weitere Daten vorhanden sind, werden sie mit meinem Makro auch gelöscht oder verschoben.
Falls deine Liste hinter der 17. Spalte noch Werte hat, werden sie in attilas Makro nicht berücksichtigt.
3) In attilas Beispiel werden alle Zeilen bis zur nächsten Leerzeile (CurrentRegion) berücksichtigt, in meinem Beispiel alle genuzten Zeilen (...LastCell)
Falls unter deiner Liste noch weitere Daten vorhanden sind, werden sie in meinem Makro auch bei der Ermittlung des Maximums und beim Löschen und verschieben berücksichtigt.
Falls deine Liste Leerzeilen enthält hört attilas Makro auf die Zeilen mit Maximalwerten zu kopieren. Hier ist attilla nicht konsequent. Zur Ermittlung des Maximums wird die gesamte Spalte Q berücksichtigt.
Generell ist attilas Makro ein richtiges Excel-Makro das die Funktionalität von Excel effectiver nutz und meins eine Programm das zu Beginn Daten aus dem Arbeitsblatt liest und zum Ende Daten in das Arbeitsblatt schreibt.
helmut
Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität. Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
einiges hast Du leider nicht richtig wiedergegeben.
Deswegen möchte ich folgendes ergänen, damit Andere, die sich mit Codes auseinder setzten es nicht falsch verstehen:
Code:
1) Beide Vorschläge löschen keine Zeilen, sondern schreiben nur die Zeilen mit den Maximalwerten nach oben und löschen den Inhalt der unteren Zeilen.
Das ist so nicht richtig. Ich lösche den gesamten zusammenhängenden Bereich ab Zelle A2. Wenn Überschriften diese Zelle berühren, werden diese auch gelöscht.
Nach dem Löschen, schreibe ich ab A2 die sozusagen gefilterten Werte in die Tabelle zurück.
Code:
2) In attilas Beispiel werden die ersten 17 Spalten berücksichtigt, in meinem Beispiel alle genutzten Spalten.
Bei Dir aber auch mit dieser Zeile in Deinem Code:
Code:
Const intWertSpalte As Integer = 17
Code:
3) In attilas Beispiel werden alle Zeilen bis zur nächsten Leerzeile (CurrentRegion) berücksichtigt, in meinem Beispiel alle genuzten Zeilen (...LastCell)
CurrentRegion liest einen zusammenhängenden Bereich ein. Ich muss gestehen, dass das damit auch in die Hose gehen kann.
Das sollte man bewußt einsetzen und wissen, dass man einen zusammenhängenden Bereich hat.
Hier war ich Faul, sonst bevorzuge ich das Aiuslesen der letzten belegten Zelle mit (xlUp).Row
Code:
Falls deine Liste Leerzeilen enthält hört attilas Makro auf die Zeilen mit Maximalwerten zu kopieren. Hier ist attilla nicht konsequent. Zur Ermittlung des Maximums wird die gesamte Spalte Q berücksichtigt.
Richtig, siehe meine Einlassung über dem Zitat.
Hier dann das zuletzt Erwähnte berücksichtigende Code:
Code:
Sub ati()
Dim i As Long, j As Long, k As Long
Dim lngZ As Long
Dim lngMax As Long
Dim lngAnzahlm As Long
Dim feld
Dim arr()
With Sheets("Tabelle1")
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
lngMax = Application.Max(.Columns("Q"))
lngAnzahlm = Application.CountIf(.Columns("Q"), lngMax)
feld = .Range("A2:Q" & lngZ)
ReDim arr(lngAnzahlm - 1, 16)
For i = 0 To lngZ - 2
If feld(i + 1, 17) = lngMax Then
For j = 0 To 16
arr(k, j) = feld(i + 1, j + 1)
Next j
k = k + 1
End If
Next i
.Range("A2:A" & lngZ).CurrentRegion.ClearContents
.Range("A2:Q" & 2 + k - 1) = arr
End With
End Sub
![[-]](https://www.clever-excel-forum.de/images/collapse.png)