Hallo Excel Community!
Ich habe folgendes "Problem" und in VBA kenne ich mich leider überhaupt nicht aus :huh:
Ein Messprogramm liefert an mein Excelsheet eine Datenreihe in der Spalte A in der Form von
12:24:49 01: +000.12 br D2.6
02: +0024.2 °C NiCr
12:24:50 01: +000.12 br D2.6
02: +0024.3 °C NiCr
usw. Dabei können beliebig viele Zeilen mit Werten gefüllt sein. Wie erstelle ich denn jetzt eine Makro, die die Messwerte für den Druck (br) in einer Spalte darstellt und die Spalte daneben mit den Temperaturmesswerten (°C) füllt? Das ganze sollte so lange geschehen, bis in der Spalte A kein neuer Messwert mehr steht.
Ich bedanke mich schon einmal für Rückmeldungen! :blush:
[
attachment=8346]
Hallöchen,
ich bin hier mal einen Weg gegangen, wie man es auch manuell erledigen könnte. In Spalte B eine Formel eintragen, die jede zweite Zeile übernimmt, dann Formeln durch Werte ersetzen, Filtern und die leeren Zeilen löschen. Per Makro sieht das so aus:
Code:
Sub Makro2()
'Variablendeclaration
'Long
Dim lRow&
'letzte belegte Zeile feststellen
lRow = Cells(Rows.Count, 1).End(xlUp).Row
'Mit dem Bereich in Spalte B
With Range("B1:B" & lRow)
'Formel zur Uebernahme jeder zweiten Zeile eintragen
.FormulaR1C1 = "=IF(MOD(ROW(),2)=1,R[1]C[-1],"""")"
'ergebnisse kopieren
.Copy
'...und Durch Werte ersetzen
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Autofilter setzen, nur leere anzeigen
.AutoFilter Field:=2, Criteria1:="="
'sichtbare Zeilen loeschen
.EntireRow.Delete
'autofilter zuruecksetzen
.AutoFilter
'Ende Mit dem Bereich in Spalte B
End With
End Sub
Hallo,
danke André fürs Hochholen.
Das ist mein Vorschlag:
Sub MesswerteAufdroeseln()
Dim lngZ As Long
Dim varQ As Variant, varZ As Variant
varQ = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Value
ReDim varZ(1 To UBound(varQ) / 2, 1 To 2)
For lngZ = 1 To UBound(varZ)
varZ(lngZ, 1) = varQ(lngZ * 2 - 1, 1)
varZ(lngZ, 1) = Mid(varZ(lngZ, 1), InStrRev(varZ(lngZ, 1), ":") + 3)
varZ(lngZ, 1) = "'" & Left(varZ(lngZ, 1), InStr(1, varZ(lngZ, 1), " "))
varZ(lngZ, 2) = varQ(lngZ * 2, 1)
varZ(lngZ, 2) = Mid(varZ(lngZ, 2), InStr(1, varZ(lngZ, 2), ":") + 3)
varZ(lngZ, 2) = "'" & Left(varZ(lngZ, 2), InStr(1, varZ(lngZ, 2), " "))
Next lngZ
Range("B2").Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ
End Sub
Gruß Uwe
Hallo,
das Ganze ließe sich auch einfach mit Formeln erledigen:
| Arbeitsblatt mit dem Namen 'Tabelle1' |
| | A | B | C | D | E |
| 1 | 12:24:49 01: +000.12 br D2.6 | | 12:24:49 | 0,12 | 24,2 |
| 2 | 02: +0024.2 °C NiCr | | 12:24:50 | 0,12 | 24,3 |
| 3 | 12:24:50 01: +000.12 br D2.6 | | | | |
| 4 | 02: +0024.3 °C NiCr | | | | |
| Zelle | Formel |
| C1 | =WENN(INDEX(A:A;(ZEILE(A1)-1)*2+1)="";"";LINKS(INDEX(A:A;(ZEILE(A1)-1)*2+1);8)) |
| D1 | =WENN(INDEX(A:A;(ZEILE(A1)-1)*2+1)="";"";WECHSELN(TEIL(INDEX(A:A;(ZEILE(A1)-1)*2+1);15;6);".";",")*1) |
| E1 | =WENN(INDEX(A:A;(ZEILE(A1)-1)*2+1)="";"";WECHSELN(TEIL(GLÄTTEN(INDEX(A:A;ZEILE(A1)*2));6;6);".";",")*1) |
| Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg |