VBA

Question

我正在尝试循环访问工作簿中的选项卡子集。我知道我可以明确地命名它们，但是可以频繁地添加或删除选项卡，我认为维护起来可能很麻烦。我需要调整的选项卡是连续的。有没有办法循环浏览一系列选项卡？

例如，如果我有一个包含 26 个选项卡 A-Z 的工作簿，我可以仅使用第一个和最后一个选项卡名称循环 D-W 吗？

Answer 1

可能是这样的：

Dim x As Long, wb As Workbook

Set wb = ThisWorkbook
For x = wb.Worksheets("D").Index to wb.Worksheets("W").Index
    With wb.Worksheets(x)
        'do something with the sheet
    End with
Next x

Answer 2

Option Explicit
Sub test()       
    Dim WS As Worksheet

    For Each WS In ThisWorkbook.Worksheets           
        If StrComp(WS.Name, "C") = 1 And StrComp(WS.Name, "X") = -1 Then                
            WS.Activate
            Range("A1").Value = "Done"                
        End If            
    Next
    
End Sub

Answer 3

以字母开头的工作表名称

第一个示例说明了如何使用该函数。

例子

Sub ArrWorksheetNamesLettersTEST1()

    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim Arr As Variant: Arr = ArrWorksheetNamesLetters(wb, "D", "W")
    If IsEmpty(Arr) Then Exit Sub ' no matching worksheet
    
    Dim ws As Worksheet
    
    For Each ws In wb.Worksheets(Arr)
        Debug.Print ws.Name
    Next ws

End Sub

Sub ArrWorksheetNamesLettersTEST2()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim Arr As Variant
    
    ' The order of the letters is not relevant.
    ' Only the first letters are considered.
    ' Case is not relevant when 'MatchCase = False' (default).
    Arr = ArrWorksheetNamesLetters(wb, "S", "dsadf")
    If Not IsEmpty(Arr) Then
        Debug.Print Join(Arr, vbLf)
    Else
        Debug.Print "Nope."
    End If

    ' Case is relevant when 'MatchCase = True': both need to have the same case.
    Arr = ArrWorksheetNamesLetters(wb, "d", "s", True)
    If Not IsEmpty(Arr) Then
        Debug.Print Join(Arr, vbLf)
    Else
        Debug.Print "Nope."
    End If

End Sub

函数

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      From a workbook ('wb'), returns the names of the worksheets,
'               whose names start with a letter from a given range of letters
'               ('Letter1' ,'Letter2'), in a one-based array.
' Remarks:      The order of the worksheets is not relevant.
'               The order of the letters is not relevant.
'               The case of the letters is relevant only
'               when 'MatchCase = True': then both have to be of the same case.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrWorksheetNamesLetters( _
    ByVal wb As Workbook, _
    ByVal Letter1 As String, _
    ByVal Letter2 As String, _
    Optional ByVal MatchCase As Boolean = False) _
As Variant
    
    Const uMin As Long = 65
    Const uMax As Long = 90
    Const lMin As Long = 97
    Const lMax As Long = 122
    Const Diff As Long = 32
    
    Dim asc1 As Long: asc1 = Asc(Left(Letter1, 1))
    Dim asc2 As Long: asc2 = Asc(Left(Letter2, 1))
    Dim IsLCase As Boolean
    
    If asc1 < uMin Then Exit Function
    If asc1 > uMax Then
        If asc1 < lMin Then Exit Function
        If asc1 > lMax Then Exit Function
        ' lMin <= asc1 <= lMax
        If MatchCase Then
            IsLCase = True
        Else
            asc1 = asc1 - Diff
        End If
    'Else ' uMin <= asc1 <= uMax
    End If
    
    If asc2 < uMin Then Exit Function
    If asc2 > uMax Then
        If asc2 < lMin Then Exit Function
        If asc2 > lMax Then Exit Function
        ' lMin <= asc2 <= lMax
        If MatchCase Then
            If Not IsLCase Then Exit Function
        Else
            asc2 = asc2 - Diff
        End If
    Else ' uMin <= asc2 <= uMax
        If MatchCase Then
            If IsLCase Then Exit Function
        End If
    End If
    
    Dim cStart As Long, cEnd As Long
    If asc1 <= asc2 Then
        cStart = asc1: cEnd = asc2
    Else
        cStart = asc2: cEnd = asc1
    End If
    
    Dim wsCount As Long: wsCount = wb.Worksheets.Count
    Dim Arr() As String: ReDim Arr(1 To wsCount)
    
    Dim cCount As Long: cCount = 2
    If MatchCase Then cCount = 1
    
    Dim sws As Worksheet
    Dim cCHR As Long
    Dim n As Long
    Dim c As Long
    
    For Each sws In wb.Worksheets
        For c = 1 To cCount
            cCHR = Asc(Left(sws.Name, 1))
            If cCHR >= (c - 1) * Diff + cStart Then
                If cCHR <= (c - 1) * Diff + cEnd Then
                    n = n + 1
                    Arr(n) = sws.Name
                    Exit For
                End If
            End If
        Next c
    Next sws
    
    If n = 0 Then Exit Function
    If n < wsCount Then ReDim Preserve Arr(1 To n)
    
    ArrWorksheetNamesLetters = Arr

End Function

VBA - 循环浏览一系列选项卡

VBA - Looping through a range of tabs

excel

foreach

loops

以字母开头的工作表名称