Sub mitDatum()
Dim strg As String
Dim lox As Long
For lox = 2 To 429 Step 7
If Right(Cells(lox, 1), 16) = "France-Allemagne" Then strg = strg & vbLf & Cells(lox, 1)
Next
MsgBox strg
End Sub
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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen