Private Sub КН_Выбор_формы_Click()
    ОКНО_ВВОДА_ДАННЫХ.Show
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim wsData As Worksheet
    Dim wsPivot As Worksheet
    Dim pt As PivotTable
    Dim pi As PivotItem
    Dim cell As Range
    Dim lookupValue As String
    
    ' Укажите имя листа с исходными данными
    Set wsData = ThisWorkbook.Sheets("ИмяВашегоЛистаСДанными")
    
    ' Укажите имя листа со сводной таблицей
    Set wsPivot = ThisWorkbook.Sheets("ИмяВашегоЛистаСводнойТаблицы")
    
    ' Укажите имя сводной таблицы
    Set pt = wsPivot.PivotTables("ИмяВашейСводнойТаблицы")
    
    ' Перебираем все элементы сводной таблицы
    For Each pi In pt.PivotFields("ИмяВашегоПоля").PivotItems
        ' Проверяем значение в сводной таблице
        If pi.DataRange.Cells(1, 1).Value = 0 Then
            ' Ищем соответствующую букву в исходных данных
            lookupValue = wsData.Range("A1:A100").Find(pi.Name).Offset(0, 1).Value ' Замените диапазон на нужный
            pi.DataRange.Cells(1, 1).Value = lookupValue ' Заменяем ноль на букву
        End If
    Next pi
End Sub

form2 = Table.TransformColumnTypes(delerr,{{"Штрихкод.1", Int64.Type},

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim Unique As New Collection
    Dim cellPaste As Range
    Dim i As Long
    Dim UniqueArray()
    
    With Worksheets("Лист1")
    Set cell = .Range("M2:N20")
    Set cellPaste = .Range("O2")
        For Each cell In Selection
        'формируем коллекцию из уникальных значений диапазона
            If cell.Value <> "" Then
                Unique.Add cell.Value, CStr(cell.Value)
            End If
        Next cell
    On Error GoTo 0
    
    ReDim UniqueArray(1 To Unique.Count, 1 To 1)
    'переносим уникальные значения в массив
        For i = 1 To Unique.Count
            UniqueArray(i, 1) = Unique.Item(i)
        Next i
    'определяем диапазон для вставки
    Set cellPaste = Range(cellPaste, cellPaste.Offset(Unique.Count - 1, 0))
    'вставляем массив в диапазон
        cellPaste.Value = UniqueArray
    
    End With

  439_352_455_616_609_352_625_616 

439
352
455
616
609
352
625
616 

.Range("C16").Value = "Марка: " & a(Str, 6) & ", Гос.номер: " & a(Str, 7) & u 

Private Sub Кнопка_Записать_Click()
        
        Dim dt As Date
        On Error Resume Next
        dt = Надпись_Дата.Caption
        Range("B3").Value = dt
                
        Range("B5").Value = Надпись_Дата.Caption
        Range("B5").NumberFormat = "dd.mm.yy"
        
End Sub

Private Sub Кнопка_Печать_Click()
'
'Вот тут будет код заполнения печатной формы.
'
'
Sheets("ПечатьЗаявка").Select 'сначала выделяем нужный лист
ФормаВвода.Hide
Application.Dialogs(xlDialogPrint).Show
Sheets("Заявки").Select
ФормаВвода.Show
End Sub

' Кнопка выход
Private Sub CommandButton6_Click()
'================= Сортировка таблицы ====================
    With Worksheets("Таблица1")
    .Range("A4:G" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort Key1:=Range("B3"), _
    Header:=xlYes, Orientation:=xlTopToBottom
    End With
'================= Закрыть окно ==========================
    Unload Forma
    ActiveWorkbook.Save
End Sub

Private Sub UserForm_activate()
    Dim a, r&, c&
            ' Скопировать диапазон в массив a()
    With Sheets("Счета")
        a = .Range(.Cells(.Rows.Count, "B").End(xlUp), "D1").Value
            ' Программно заполнить ListView
        With Me.ListView1
            ' На всякий случай очистить ListView
            .ListItems.Clear
            .ColumnHeaders.Clear
            ' Добавить заголовок
            .ColumnHeaders.Add , , a(2, 2), 70, lvwColumnLeft
            .ColumnHeaders.Add , , a(2, 3), 80, lvwColumnCenter
            .ColumnHeaders.Add , , a(2, 4), 300, lvwColumnLeft
            .ColumnHeaders.Add , , a(2, 5), 110, lvwColumnRight
            ' Заполнить строки и колонки из таблицы
        For r = 2 To UBound(a)
            c = 1
            .ListItems.Add , , Format(a(r, c), "DD.MM.YY")
            c = c + 1
            .ListItems(r - 1).ListSubItems.Add , , a(r, c)
            c = c + 1
            .ListItems(r - 1).ListSubItems.Add , , a(r, c)
            c = c + 1
            .ListItems(r - 1).ListSubItems.Add , , Format(a(r, c), "#,##0.00")
        Next
        End With
    End With
End Sub

Private Sub UserForm_Initialize()
'Автонумерация непустых строк
    With Worksheets("Temp")
.Range("A2") = 1
Dim i As Long
i = 2
Do Until .Cells(i, 1) = ""
.Cells(i, 1) = i - 1
i = i + 1
Loop

' Выводим значения таблицы в ListBox1
Dim s As Long, t 'создаем переменные LastRow As Long,
LastRow = i - 1
'LastRow = Worksheets("Temp").Range("A2").End(xlDown).Row 'ищем номер последней непустой строки
t = "A2:E" & LastRow
' t = "Temp.Cells(1, 1), Temp.Cells(LastRow, 5)"

With Me.ListBox1
'Указываем, что у нас 5 столбцов
.ColumnCount = 5
'Задаем размеры столбцов
.ColumnWidths = "40;240;50;60;60"
'Указываем, что нужна строка заголовков
.ColumnHeads = True
'Импортируем данные
.RowSource = t
.ListIndex = 0
End With
i = 2
Do Until .Cells(i, 1) = ""
Temp.Cells(i, 5) = Temp.Cells(i, 3) * Temp.Cells(i, 4)
i = i + 1
Loop
TextBox3.Text = WorksheetFunction.Sum(Range(.Cells(2, 5), .Cells(LastRow, 5)))
TextBox3.Text = Strings.Format(Val(TextBox3.Text), "#,##0.00")


End With
End Sub

'   Выпадающий список "Поиск счета"
Private Sub cmbVibor_Change()
    Dim psk As Long, p As Long
    With Worksheets("Таблица1")
        psk = Worksheets("Таблица1").Range("B4").CurrentRegion.Rows.Count
        For p = 4 To psk
    If Trim(Лист1.Cells(p, 2)) = Trim(cmbVibor.Text) Then
       SpinButton1.Value = p
       Exit For
    End If
    Next p
    End With
End Sub

=СОРТ(УНИК(Работы[Счет]))

=Служ!$A$2#

Private Sub UserForm_Initialize()
Me.ComboBox8.List = Worksheets("Служ").Range("A2").CurrentRegion.Rows.Count
End Sub

' ========================= Кнопка Закрыть =================================
Private Sub CommandButton1_Click()
'================= Закрыть окно ==========================
    Vvod.Hide
'================= Сортировка таблицы ====================
    Range("B3:AF" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Key1:=Range("B2"), _
    Header:=xlYes, Orientation:=xlTopToBottom
End Sub

' ========================= Кнопка Закрыть =================================
Private Sub CommandButton2_Click()
'================= Закрыть окно ==========================    
    UserForm1.Hide
'================= Сортировка таблицы ====================
    Range("A5:H" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Key1:=Range("A4"), _
    Orientation:=xlTopToBottom

End Sub

Private Sub UserForm_Initialize()
    
    Dim a As Range
    Set a = Range("Штат[ФИО]").Value
    ComboBox1.List = a
    
End Sub

 Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    Dim xRg As Range
    Application.ScreenUpdating = False
        For Each xRg In Range("C8:C17")
            If (xRg.Value = "") Or (xRg.Value = "0") Then
                xRg.EntireRow.Hidden = True
            Else
                xRg.EntireRow.Hidden = False
            End If
        Next xRg
    Application.ScreenUpdating = True
End Sub

Private Sub Кнопка1_Click()
    If Кнопка1 = True Then
    'Макрос Worksheet_Change выполняется
    Else
    'Макрос Worksheet_Change не выполняется и все строки,
    'если были скрыты до этого, должны раскрыться.
    End If
End Sub