AW: Benötige Hilfe bei VBA
10.01.2018 10:39:46
fcs
Hallo Karle,
im Blindflug -ohne den genauen Aufbau zu kennen hätte ich folgenden Vorschlag zur Aufbereitung:
1. Kopiere die Spalte A in die Spalte I
2. Ersetze via Suchen/Ersetzen in Spalte I "__" durch "."
3. Ersetze via Suchen/Ersetzen in Spalte I "_" durch ""
In Spalte I sollten die Werte dann so aussehen: DOWN03.SC01.1.hdf
d.h. "__" istdurch einen Punkt ersetzt und "_" am Anfang durh nichts(Leer-String)
4. Die Text-Daten in Spalte I und via Menü "Daten" --> "Text in Spalten" am "."in Spalten trennen
5. Falls notwendig vor Zeile 1 eine Leerzeile einfügen.
7. Fehlende Spaltentitel eintragen.
6. Falls notwendig in weiteren Spalten für die Auswertung Hilfsberehnungen einfügen (z.B. Summe der 7 Messwerte, Anzahl der Messwerte, Mittelwert der 7 Messwerte)
In dieser Form kann man die Daten jetzt gut Sortieren, Auswerten - z.B. per Pivot-Tabellenbericht.
Ein Makro für die Aufbereitung der Daten kann dann wie folgt aussehen.
Test-Datei mit Beispieldaten
https://www.herber.de/bbs/user/118850.xlsx
Gruß
Franz
Sub DatenAufbereiten()
' DatenAufbereiten Makro
Dim wks As Worksheet
Dim Zei_L As Long
Set wks = ActiveSheet
With wks
'Spalte A kopieren nach SpalteI
.Columns("A:A").Copy .Columns("I:I")
Application.CutCopyMode = False
With Columns("I:I")
'Daten für "Text in Spalten" aufbereiten
.Replace What:="__", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="_", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Text am "." in Spalten aufteilen
.TextToColumns Destination:=wks.Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
OtherChar:=".", _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 1), Array(4, 2)), _
TrailingMinusNumbers:=True
End With
'Zeile für Spaltentitel einfügen wenn noch nicht vorhanden
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Fehlende Spaltentitel ergänzen
.Range("A1").Value = "Dateiname"
.Range("B1").Value = "MW1"
.Range("C1").Value = "MW2"
.Range("D1").Value = "MW3"
.Range("E1").Value = "MW4"
.Range("F1").Value = "MW5"
.Range("G1").Value = "MW6"
.Range("H1").Value = "MW7"
.Range("I1").Value = "Typ"
.Range("J1").Value = "Bauteil"
.Range("K1").Value = "Nr"
.Range("L1").Value = "Ext"
.Range("M1").Value = "Summe MW"
.Range("N1").Value = "Anzahl"
.Range("O1").Value = "Mittelwert MW"
'Zusatzberechnungen zur Auswertung
Zei_L = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile mit Daten
'Summe der 7 Messwerte in Spalte M
.Range(.Cells(2, 13), .Cells(Zei_L, 13)).FormulaR1C1 = "=SUM(RC2:RC8)"
'Anzahl der Messwerte in Spalte N - für berechnetes Feld n Pivot-Bericht
.Range(.Cells(2, 14), .Cells(Zei_L, 14)).FormulaR1C1 = "=COUNT(RC2:RC8)"
'Mittelwert der 7 Messwerte
.Range(.Cells(2, 15), .Cells(Zei_L, 15)).FormulaR1C1 = "=AVERAGE(RC2:RC8)"
'Formeln durch Werte ersetzen
With .Range(.Cells(2, 13), .Cells(Zei_L, 15))
.Calculate
.Value = .Value
End With
'Breite der Zusatzspalten optimieren
.Columns("I:O").Columns.AutoFit
'Fenster unterhalb der Titelzeile fixieren
.Range("A2").Select
ActiveWindow.FreezePanes = True
End With 'wks
End Sub