Microsoft Excel

Herbers Excel/VBA-Archiv

Daten auslesen...........



Excel-Version: 9.0 (Office 2000)

Betrifft: Daten auslesen...........
von: markus
Geschrieben am: 03.06.2002 - 17:21:01

hallo zusammen!
habe eine schwierige aufgabe:wie kann ich in einer datentabelle die 3 "datenblöcke" enthält (spalte a bis e, zeilen: 7 bis ~)die jeweiligen blöcke seperat auslesen? knackpunkt: nach dem ersten block kommen 2 leerzeilen und dann eine summe, dann wieder der nächste datenblock, und wieder dasselbe. hintergrund: es sind maschineneffizienzen die aus einem system kommen, aber leider nur "gesammelt" in einer .tmp datei ausgegeben werden. da ich in einem block mehrere maschinen per formel zusammenfasse, habe ich aber keine unterscheidung zwischen den schichten. einzige lösung wäre vielleicht, wenn ich excel irgendwie sagen kann, das wenn die ersten 2 leerzeilen kommen = schicht 1, wenn die nächsten 2 leerzeilen kommen, schicht 2, usw....ich würde das ganze dann versuchen in ein makro zu packen.
gruss markus
  

Re: Daten auslesen...........
von: WernerB.
Geschrieben am: 03.06.2002 - 21:32:55

Hallo Markus,

mangels detaillierter Information (Aufgabenstellung/Problem und Randbedingungen) hier ein Lösungsansatz; ob er Deinen Vorstellungen entspricht, weiß ich leider nicht.
Das Makro erstellt in einer Schleife drei neue Blätter und kopiert jeweils einen "Schicht-Block" hinein.


Option Explicit
Sub SchichtBloecke()
Dim fiR As Long, laR As Long, laR0 As Long, laR1 As Long, i As Long, j As Long
    fiR = 7
    laR0 = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To 3
      For j = fiR To laR0
        If IsEmpty(Sheets("Tabelle1").Cells(j + 1, 1)) And _
          IsEmpty(Sheets("Tabelle1").Cells(j + 2, 1)) Then
          laR = j
          Exit For
        End If
      Next j
      Sheets.Add
      ActiveSheet.Move After:=Sheets(Sheets.Count)
      laR1 = laR - fiR + 1
      Sheets("Tabelle1").Range("A" & fiR & ":E" & laR).Copy
      Sheets(Sheets.Count).Range("A1:E" & laR1).PasteSpecial Paste:=xlValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
      fiR = laR + 3
    Next i
End Sub

Viel Erfolg wünscht
WernerB.