Neuer Versuch: Makro ändern!
06.06.2018 11:10:31
lanala
vllt habe ich mich in meinem letzten Post etwas kryptisch aus gedrückt, deshalb versuche ich es erneut.
um Daten mit einer Toleranzgrenze zu Entfernen schrieb mir fcs ein Makro. Dies wollte ich jetzt umändern weil sich die Anzahl meiner Spalten geändert haben. Leider krieg ich es nicht hin :(.
hier das die Datei wie sie damals aussah:
https://www.herber.de/bbs/user/121620.xlsx
sowie das passende Makro dazu:
Sub Daten_Aufbereiten()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim rngDaten As Range
Dim arrDaten, arrErgebnis()
Dim varMaxm_z, varRT_min, varDS
Dim Zeile As Long, Zeile_L As Long
Dim Spalte_Q As Long, Spalte As Long
Set wksQuelle = ActiveWorkbook.Worksheets(1) 'Sheet1
Set wksZiel = ActiveWorkbook.Worksheets(2) 'Tabelle1
With wksQuelle
'Datensätze in Quell-Blatt abarbeiten - ab Spalte B in 6er-Schritten
For Spalte_Q = 2 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 6
varDS = .Cells(1, Spalte_Q).Value 'Bezeichnung des Datensatzes merken
'Datenzeilen des Datensates sortieren und in Daten-Array einlesen
Zeile_L = .Cells(.Rows.Count, Spalte_Q).End(xlUp).Row
Set rngDaten = .Range(.Cells(2, Spalte_Q), .Cells(Zeile_L, Spalte_Q + 4))
With rngDaten
'sortieren nach "RT [min]" und "Max. m/z"
.Sort Key1:=.Range("B1"), order1:=xlAscending, key2:=.Range("E1"), _
Order2:=xlAscending, Header:=xlYes
'sortierte Daten inkl. Spaltentitel in Array einlesen
arrDaten = .Value2
'sortieren nach "#" - ursprüngliche Sortierung wieder herstellen
.Sort Key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
End With
'im Daten-Array doppelte Datenzeilen markieren
varRT_min = "": varMaxm_z = "": Zeile_L = 1
For Zeile = LBound(arrDaten, 1) + 1 To UBound(arrDaten, 1)
'Prüfen, ob Werte in Spalte "RT [min]" sich ändert
If varRT_min arrDaten(Zeile, 2) Then
'Werte merken von "RT [min]" und "Max. m/z" - Zeile nicht als doppelt markieren
varRT_min = arrDaten(Zeile, 2)
varMaxm_z = arrDaten(Zeile, 5)
Zeile_L = Zeile_L + 1
Else
'Prüfen, ob Wert in "Max. m/z" innerhalb der Toleranz zum gemerkten Wert
If arrDaten(Zeile, 5) - varMaxm_z "D" Then
Zeile_L = Zeile_L + 1
For Spalte = LBound(arrDaten, 2) To UBound(arrDaten, 2)
arrErgebnis(Zeile_L, Spalte) = arrDaten(Zeile, Spalte)
Next
End If
Next
'Ergebnis-Daten im Zielblatt eintragen
With wksZiel
'Datensatz-Beschreibung eintragen in Zeile 1
.Cells(1, Spalte_Q).Value = varDS
'nicht doppelte Daten in Zielblatt eintragen
.Cells(2, Spalte_Q).Resize(Zeile_L, 5) = arrErgebnis
'Zeilen des Datensatzen nach "#" sortieren
Zeile_L = .Cells(.Rows.Count, Spalte_Q).End(xlUp).Row
Set rngDaten = .Range(.Cells(2, Spalte_Q), .Cells(Zeile_L, Spalte_Q + 4))
With rngDaten
'sortieren nach "#"
.Sort Key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
End With
End With
Erase arrDaten, arrErgebnis 'Daten-Arrays zuücksetzen/leeren
Next Spalte_Q
End With
wksZiel.Activate
End Sub
https://www.herber.de/bbs/user/121953.xlsx
mein Änderungsversuch lautet wie folgt:
Sub Daten_Aufbereiten()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim rngDaten As Range
Dim arrDaten, arrErgebnis()
Dim varMaxm_z, varRT_min, varDS
Dim Zeile As Long, Zeile_P As Long
Dim Spalte_Q As Long, Spalte As Long
Set wksQuelle = ActiveWorkbook.Worksheets(1) 'Sheet1
Set wksZiel = ActiveWorkbook.Worksheets(2) 'Tabelle1
With wksQuelle
'Datensätze in Quell-Blatt abarbeiten - ab Spalte B in 6er-Schritten
For Spalte_Q = 2 To .Cells(2, .Columns.Count).End(xlToLeft).Column Step 6
varDS = .Cells(1, Spalte_Q).Value 'Bezeichnung des Datensatzes merken
'Datenzeilen des Datensates sortieren und in Daten-Array einlesen
Zeile_P = .Cells(.Rows.Count, Spalte_Q).End(xlUp).Row
Set rngDaten = .Range(.Cells(2, Spalte_Q), .Cells(Zeile_P, Spalte_Q + 6))
With rngDaten
'sortieren nach "RT [min]" und "Max. m/z"
.Sort Key1:=.Range("B1"), order1:=xlAscending, key2:=.Range("G1"), _
Order2:=xlAscending, Header:=xlYes
'sortierte Daten inkl. Spaltentitel in Array einlesen
arrDaten = .Value2
'sortieren nach "#" - ursprüngliche Sortierung wieder herstellen
.Sort Key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
End With
'im Daten-Array doppelte Datenzeilen markieren
varRT_min = "": varMaxm_z = "": Zeile_P = 1
For Zeile = LBound(arrDaten, 1) + 1 To UBound(arrDaten, 1)
'Prüfen, ob Werte in Spalte "RT [min]" sich ändert
If varRT_min arrDaten(Zeile, 2) Then
'Werte merken von "RT [min]" und "Max. m/z" - Zeile nicht als doppelt markieren
varRT_min = arrDaten(Zeile, 2)
varMaxm_z = arrDaten(Zeile, 7)
Zeile_P = Zeile_P + 1
Else
'Prüfen, ob Wert in "Max. m/z" innerhalb der Toleranz zum gemerkten Wert
If arrDaten(Zeile, 7) - varMaxm_z arrDaten(Zeile, 1) = "D" 'markieren als Doppelt
Else
'Wert merken von "Max. m/z" - Zeile nicht als doppelt markieren
varMaxm_z = arrDaten(Zeile, 7)
Zeile_P = Zeile_P + 1
End If
End If
Next
'Ergebnis-Array für nicht doppelte Datensätze dimensionieren
ReDim arrErgebnis(1 To Zeile_P, LBound(arrDaten, 2) To UBound(arrDaten, 2))
Zeile_P = 0
'nicht doppelte Datenzeilen in Ergebnis-Array übertragen
For Zeile = LBound(arrDaten, 1) To UBound(arrDaten, 1)
If arrDaten(Zeile, 1) "D" Then
Zeile_P = Zeile_P + 1
For Spalte = LBound(arrDaten, 2) To UBound(arrDaten, 2)
arrErgebnis(Zeile_P, Spalte) = arrDaten(Zeile, Spalte)
Next
End If
Next
'Ergebnis-Daten im Zielblatt eintragen
With wksZiel
'Datensatz-Beschreibung eintragen in Zeile 1
.Cells(1, Spalte_Q).Value = varDS
'nicht doppelte Daten in Zielblatt eintragen
.Cells(2, Spalte_Q).Resize(Zeile_P, 7) = arrErgebnis
'Zeilen des Datensatzen nach "#" sortieren
Zeile_P = .Cells(.Rows.Count, Spalte_Q).End(xlUp).Row
Set rngDaten = .Range(.Cells(2, Spalte_Q), .Cells(Zeile_P, Spalte_Q + 6))
With rngDaten
'sortieren nach "#"
.Sort Key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
End With
End With
Erase arrDaten, arrErgebnis 'Daten-Arrays zuücksetzen/leeren
Next Spalte_Q
End With
wksZiel.Activate
End Sub
Wobei er mir hier ein Fehler Anzeigt: If arrDaten(Zeile, 7) - varMaxm_z
kurze Erklärung was es eigentlich tun soll:
Er soll den Datensatz von XXX auf doppelte Prüfen. Dabei geht es um die Reihen C (RT [min]) und F (Max. m/z) als Datenpaare. Sind sowohl RT als auch Max. m/z in den Reihen von XXX gleich, dann sollte er eins davon rausschmeißen. Dies soll mit einer Toleranz in Max. m/z von 0.1 passieren.
Zu deinem Beispielen:
(3x innerhalb Toleranz 0,1):
...
1,00001
1,00002
1,00003
hier Bitte den ersten Wert stehen lassen.
ich hoffe ich habe mich verständlicher ausgedrückt und ich finde jemanden der mir helfen kann.
lg lanala