Wie Tabs nach Namen gruppieren?
19.08.2021 10:24:18
AleXSR700
ich möchte mein aktuelles Projekt abschließen, indem ich alle Tabs, die mit den gleichen 6 Zeichen beginnen, hintereinandersortiere. Leider fällt mir keine sinnvolle Lösung hierzu ein.
Ich sortiere und markiere bereits Tabs basierend auf bestimmten Inhalten. Aber dabei wird stets nur das aktuelle betrachtet. Für das Gruppieren müssen aber alle Tabs betrachtet werden.
Ziel ist, alle Tabs, die mit Replace(strFile, ".out", "") beginnen, nebeneinander stehen zu haben.
Hier mal mein bisheriger Code
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = Replace(strFile, ".out", "") Then
Set farng = Worksheets("Overview").Cells.Find(What:=sh.Name, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
For Each cell In farng
Worksheets("Overview").Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:="'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
Next cell
Set statusread = sh.Cells.Find(What:="Status", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set statusread = statusread.Offset(2, 3)
farng.Offset(0, 7) = statusread
If statusread "o.k." Then
sh.Tab.ColorIndex = 3
farng.Font.Bold = True
farng.Font.Color = vbRed
farng.Offset(0, 7).Font.Bold = True
farng.Offset(0, 7).Font.Color = vbRed
sh.Move after:=Worksheets("Overview")
End If
If statusread = "" Then
sh.Tab.ColorIndex = 6
farng.Font.Bold = True
farng.Font.Color = vbRed
farng.Offset(0, 7).Font.Bold = True
farng.Offset(0, 7).Font.Color = vbYellow
sh.Move after:=Worksheets("Overview")
End If
End If
Next sh
Function RangeExists(ByVal WhatSheet As String, Optional ByVal WhatRange As String = "A1") As Boolean
Dim test As Range
On Error Resume Next
Set test = ActiveWorkbook.Sheets(WhatSheet).Range(WhatRange)
RangeExists = Err.Number = 0
On Error GoTo 0
End Function