AW: nur nochmal als Zusatz-Info ...
11.08.2010 22:29:48
Horst
Hallo Jungs,
irgendwie scheint das Makro nicht das zu machen, was ich wollte. Meine Intention war eigentlich, bei untenstehenden VBA-Code einzubauen, dass zusätzlich zu den bereits berücksichtigten Parametern "Datum", "Uhrzeit", "Menge" und "Preis" noch die Textfolge "France-Allemagne" bzw. "Allemagne-France" aus der jeweils ersten Zeile einer Rubrik ausgelesen und ausgegeben wird. Wie mache ich das am besten?
Sub Copy_Transpose_Range()
Dim rngTitel As Range, rngDaten As Range, rngTmp As Range
Dim lngAbstand As Long
Dim meARDate(), nCount
With Sheets("Daten")
Set rngTitel = .Range("A4:A6")
Set rngTmp = .Columns(1).Find(What:="Heure", LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not rngTmp Is Nothing Then
Set rngDaten = rngTmp.Offset(0, 1).Resize(3, 24)
nCount = nCount + 1
ReDim Preserve meARDate(1 To nCount)
meARDate(nCount) = FindDateInString(rngTmp.Offset(-2, 0).Text)
Set rngTmp = .Columns(1).FindNext(rngTmp)
Do While rngTmp.Address rngTitel(1).Address
nCount = nCount + 1
ReDim Preserve meARDate(1 To nCount)
meARDate(nCount) = FindDateInString(rngTmp.Offset(-2, 0).Text)
Set rngDaten = Union(rngDaten, rngTmp.Offset(0, 1).Resize(3, 24))
Set rngTmp = .Columns(1).FindNext(rngTmp)
Loop
End If
End With
nCount = 1
If Not rngDaten Is Nothing Then
With Sheets.Add(After:=Sheets(Sheets.Count))
.Range("A1") = "Datum"
.Range("B1:D1") = Application.Transpose(rngTitel)
.Rows(1).Font.Bold = True
For Each rngTmp In rngDaten.Areas
With .Range("A2").Offset(lngAbstand, 0)
.Offset(0, 1).Resize(24, 3).Value = Application.Transpose(rngTmp)
.Resize(24, 1) = meARDate(nCount)
.Resize(24, 1).NumberFormat = "m/d/yyyy"
End With
nCount = nCount + 1
lngAbstand = lngAbstand + rngTmp.Columns.Count
Next rngTmp
.UsedRange.EntireColumn.AutoFit
End With
End If
Set Regex = Nothing
End Sub