Hilfe bei Änderung von Makro
04.06.2018 14:28:33
Makro
sry an fcs, Chris & Co. die versucht haben meine letzte Frage zu beantworten. Da ich mich zwischen zeitlich mit etwas anderem beschäftigt habe, hatte ich bisher noch keine Gelegenheit hier nochmal reinzuschauen.
das Makro von fcs hat sehr gut funktioniert. Nun habe ich ein etwas anderes Layout und bekomme die Änderung einfach nicht hin :(.
Hier das Bsp Sheet
https://www.herber.de/bbs/user/121953.xlsx
Ursprüngliches Makro von fcs (an dieser Stelle nochmal vielen Dank):
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
Mein änderungsversuch ist wahrscheinlich erbärmlich. Obwohl fcs sich echt bemüht hat es auch noch zu erklären.
würde mich freuen wenn jemand helfen könnte und vllt für etwas Aufklärung sorgen könnte:
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, 5)
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, 5) = 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
If arrDaten(Zeile, 7) - varMaxm_z