Option Explicit
Sub test()
Dim i&
Dim dict As New Dictionary
Dim dictIndex As New Dictionary
Dim arr As Variant
Dim infinity As Double
Dim key As String
Dim arrTemp As Variant
Dim Results As Variant
arr = [Пример].Value2
infinity = Timer
Call DisabledApps(False, False)
For i = LBound(arr) To UBound(arr)
key = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
If arr(i, 3) = "Ниже нормы" Then
If Not dict.Exists(key) Then
dict.Add key, 1
dictIndex.Add i, ""
Else
dict(key) = dict(key) + 1
End If
End If
Next i
arrTemp = Array(dict.Keys, dict.Items, dictIndex.Keys)
ReDim Results(1 To UBound(arrTemp(0)) + 1, 1 To 4)
For i = 1 To UBound(arrTemp(0)) + 1
Results(i, 1) = arr(arrTemp(2)(i - 1), 1)
Results(i, 2) = arr(arrTemp(2)(i - 1), 2)
Results(i, 3) = arr(arrTemp(2)(i - 1), 3)
Results(i, 4) = arrTemp(1)(i - 1)
Next i
On Error Resume Next: [Tb].Delete: On Error GoTo 0
[Tb].Resize(UBound(Results), 4) = Results
Call DisabledApps(True, True)
MsgBox "Готово!", vbInformation, Format(Timer - infinity, "0.00 сек")
End Sub
Public Function DisabledApps(OnOff As Boolean, CalculateApp As Boolean): If CalculateApp = False Then CalculateApp = xlManual Else CalculateApp = xlAutomatic
Application.ScreenUpdating = OnOff
Application.Calculation = CalculateApp
Application.AskToUpdateLinks = OnOff
Application.DisplayAlerts = OnOff
End Function
Sub jmqw()
Dim N As String
Dim A As Range
Dim B As Range
Set A = Worksheets("тест").Rows(2).Find(300)
If A Is Nothing Then Exit Sub
N = A.MergeArea.Address
Set B = Range(N)
B.Columns.Hidden = Not B.Columns.Hidden
End Sub
Код
Sub NJwq()
Dim N As String
Dim A As Range
Dim B As Range
Set A = Worksheets("тест").Rows(2).Find(300)
If A Is Nothing Then Exit Sub
N = A.MergeArea.Address
Set B = Range(N)
If B.Columns.Hidden = True Then
B.Columns.Hidden = False
ElseIf B.Columns.Hidden = False Then
B.Columns.Hidden = True
End If
End Sub
При отсутствии фильтра отрабатывают на ура, но как только ставишь любой фильтр на любом столбце перестаёт отрабатывать возврат столбцов. Как то можно это пофиксить?
Исходя из логики файла закрепил нужные диапазоны, но Вам лучше знать какие нужно закрепить. А если не понимаете как, то лучше почитать как это делается.