Select 多个工作表中的相同区域

Question

所以我需要 select 在所有工作表中使用相同的范围 除了“Sheet1”。该范围是动态的，基于 A 列上的值“s1”。所以我想 select B 列中的值 s1，将其设为粗体，然后计算 C 列中的 s1 值。这是我目前所拥有的

Sub test() Dim ws As Worksheet Dim lastrow As Long Dim xRg As Range, yRg As Range, zRg As Range Dim cell As Range Dim C1 As Range For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Sheet1" Then lastrow = Cells(Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False For Each xRg In Range("A1:A" & lastrow) If xRg.Text = "s1" Then If yRg Is Nothing Then Set yRg = Range("B" & xRg.Row).Resize(, 1) k = 1 For Each cell In yRg yRg.Cells(k, 2) = k yRg.Cells.Select k = k + 1 Next cell Else Set yRg = Union(yRg, Range("B" & xRg.Row).Resize(, 1)) If Not yRg Is Nothing Then yRg.Select For Each C1 In yRg C1.EntireRow.Font.Bold = True Next C1 End Sub

Answer 1

试试这个代码：

Option Explicit

Sub test()
    Dim ws As Worksheet
    Dim xRg As Range, yRg As Range

    Application.ScreenUpdating = False
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then
            ws.Cells.Font.Bold = False   ' clear bold formatting for debugging purposes
            Set yRg = Nothing
            For Each xRg In ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
                If xRg.Text = "s1" Then
                    If yRg Is Nothing Then
                        Set yRg = xRg.Offset(0, 1)
                    Else
                        Set yRg = Union(yRg, xRg.Offset(0, 1))
                    End If
                    xRg.Offset(0, 2) = yRg.Cells.Count 'set entry number
                End If
            Next xRg
            If Not yRg Is Nothing Then yRg.Font.Bold = True
        End If
    Next ws
    
    Application.ScreenUpdating = True
End Sub

Before

After

Answer 2

选择或范围不跨越多个 sheet；每个 sheet 有一个选择。所以你需要在每个 sheet.

内工作

你有很多未闭合的循环和条件。这是我对您尝试执行的操作的最佳猜测：

Sub test()
    Dim ws As Worksheet
    Dim lastrow As Long
    Dim xRg As Range, yRg As Range
    Dim cell As Range
    Dim s1count As Long

    For Each ws In ThisWorkbook.Worksheets
      If ws.Name <> "Sheet1" Then
        Set yRg = Nothing
        lastrow = Cells(Rows.Count, "A").End(xlUp).Row
        For Each xRg In Range("A1:A" & lastrow)
            If xRg.Text = "s1" Then
                If yRg Is Nothing Then
                    Set yRg = xRg.Offset(0, 1)
                Else
                    Set yRg = Union(yRg, xRg.Offset(0, 1))
                End If
            End If
        Next xRg
        If Not yRg Is Nothing Then
            s1count = 0
            For Each cell In yRg
                cell.EntireRow.Font.Bold = True
                s1count = s1count + 1
                cell.Offset(0, 1) = s1count
            Next cell
        End If
      End If
    Next ws

End Sub

Select 多个工作表中的相同区域

Select the same range in multiple workheets

vba

counter

range