Добрый день Предисловие: просьба сразу не кидать котлетами с истекшим сроком годности, а лучше ссылочку на решение задачи
Имеется массив данных из которого надо на основной лист вытащить определенные данные из выпадающего списка, файл Книгаодин.xlsx (18.87 КБ). у Пользователя будет возможность выбирать по 1-му (как в примере) или нескольким условиям, чтобы он видел конкретную информацию.
Возможно я невнимательно искал на форуме, поэтому прошу дать ссылку или в текущей теме поделиться решением задачи
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2")) Is Nothing Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim arr, arr2, i As Long, n As Long, lr As Long
Dim sh As Worksheet
Set sh = Worksheets("База")
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
x = Application.WorksheetFunction.CountIf(sh.Columns(3), Target)
arr = sh.Range("B2:F" & lr)
Range(Cells(5, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row + 5, 6)).Clear
ReDim arr2(1 To x, 1 To 3): k = 1
For i = LBound(arr) To UBound(arr)
If arr(i, 2) = Target Then
arr2(k, 1) = arr(i, 3)
arr2(k, 2) = arr(i, 4)
arr2(k, 3) = arr(i, 5)
k = k + 1
End If
Next i
Range("B5").Resize(UBound(arr2), 3) = arr2
With Range("B5").Resize(UBound(arr2), 3)
.Borders.LineStyle = xlDouble
.Borders.Color = -11489280
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
End If
End Sub