2 версии ниже работают одинаково
- Если значения в
Sheet1.ColA соответствуют значениям в Sheet2.ColB (Sheet3.ColB и т. Д.)
- И, если строка в
Sheet1 скрыта
- Он будет скрывать (идентичные) строки в
Sheet2, 3 и т. Д.
.
Версия 1
Option Explicit
Public Sub MatchAndHideRows()
Const COL_1 = "A" 'column with text data in Sheet1 (Master Sheet)
Const COL_2 = "B" 'column with text data in Sheets 2, 3, etc
Dim ws1 As Worksheet, lr1 As Long, arr1 As Variant, d1 As Object
Dim ws2 As Worksheet, lr2 As Long, arr2 As Variant, d2 As Object, r As Long
Set ws1 = Sheet1 'Master Sheet (Or: Set ws1 = ThisWorkbook.Worksheets("Sheet1"))
lr1 = ws1.Cells(ws1.Rows.Count, COL_1).End(xlUp).Row
arr1 = ws1.Range(ws1.Cells(1, COL_1), ws1.Cells(lr1, COL_1)).Formula
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For r = 10 To lr1 'skip Header rows
If ws1.Rows(r).Hidden Then d1(arr1(r, 1)) = 0 'remember all hidden rows
Next
For Each ws2 In ThisWorkbook.Worksheets 'iterate all sheets
If ws1.Name <> ws2.Name Then 'except Master Sheet (Sheet1)
lr2 = ws2.Cells(ws2.Rows.Count, COL_2).End(xlUp).Row
arr2 = ws2.Range(ws2.Cells(1, COL_2), ws2.Cells(lr2, COL_2)).Formula
For r = 5 To lr2 'skip Headers
If d1.Exists(arr2(r, 1)) Then d2(r) = 0
Next
ws2.UsedRange.Rows.Hidden = False
If d2.Count > 0 Then
ws2.Range("A" & Join(d2.Keys, ",A")).EntireRow.Hidden = True
End If
End If
Next
End Sub
.
Версия 2
Public Sub MatchAndHideRowsCheckRowByRow()
Const COL_1 = "A" 'column with text data in Sheet1 (Master Sheet)
Const COL_2 = "B" 'column with text data in Sheets 2, 3, etc
Dim ws1 As Worksheet, lr1 As Long, rng1 As Range, c1 As Range
Dim ws2 As Worksheet, lr2 As Long, rng2 As Range, c2 As Range
Set ws1 = Sheet1 'Master Sheet (Or: Set ws1 = ThisWorkbook.Worksheets("Sheet1"))
lr1 = ws1.Cells(ws1.Rows.Count, COL_1).End(xlUp).Row
Set rng1 = ws1.Range(ws1.Cells(10, COL_1), ws1.Cells(lr1, COL_1)) 'skip Header rows
Application.ScreenUpdating = False
For Each c1 In rng1.Cells 'iterate each cell with data in Sheet1.ColA
If Not IsError(c1) Then 'if current cell doesn't contain an error, continue
For Each ws2 In ThisWorkbook.Worksheets 'iterate all sheets
If ws1.Name <> ws2.Name Then 'except Master Sheet (Sheet1)
lr2 = ws2.Cells(ws2.Rows.Count, COL_2).End(xlUp).Row
Set rng2 = ws2.Range(ws2.Cells(5, COL_2), ws2.Cells(lr2, COL_2))
For Each c2 In rng2.Cells 'iterate each cell in current sheet
If Not IsError(c2) Then
If c1.Value2 = c2.Value2 Then
c2.EntireRow.Hidden = c1.EntireRow.Hidden
End If
End If
Next
End If
Next
End If
Next
Application.ScreenUpdating = True
End Sub