Makro zum Kopieren bis eine leere Zeile kommt

[ambropete]

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:

   

[schauan]

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

[Kuwer]

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

[BoskoBiati]

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