vba - 在多个工作表中选择相同的范围

Question

所以我需要在除“Sheet1”之外的所有工作表中选择相同的范围。该范围是基于 A 列上的值“s1”的动态范围。所以我想为值 s1 选择 B 列中的内容，使其变为粗体，然后计算 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

标签： vbarangecounter

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

前

后