Option Explicit
Private Sub MoveUpButton_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1.Text = "Произведен двойной щелчок"
    Cancel = False
    Call MoveUpButton_Click
End Sub
Private Sub MoveDownButton_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Cancel = False
    Call MoveDownButton_Click
End Sub

Private Sub MoveUpButton_Click()
    ShiftItem ListBox1, True
End Sub
Private Sub MoveDownButton_Click()
    ShiftItem ListBox1, False
End Sub

Private Sub ShiftItem(ByRef lb As MSForms.Control, bUp As Boolean)
    Dim i%, j%, l()
    With lb
        i = .ListIndex
        If i + bUp >= 0 And i + bUp < lb.ListCount - 1 Then
            l = .List
            For j = 0 To UBound(l, 2)
                swap l(i, j), l(i + (1 Or bUp), j):
            Next
            .List = l
        End If        
    End With
End Sub
Private Sub swap(ByRef a, ByRef b)
    Dim c: c = a: a = b: b = c
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .List = [transpose(proper(text(row(r1:r12)*30,"[$-419]mmmm")))]
        .ListIndex = 0
    End With
End Sub

Private Sub OKButton_Click()
    Unload Me
End Sub

Sub ShowDialog()
    UserForm1.Show
End Sub

With .CmbDD1
.List = [transpose(text(row(r1:r31),"dd"))] 'Заполнение данными дата CmbDD1
.ListIndex = Day(Date) - 1 'Вывод текущей даты в поле просмотра
.additem"",0
End With

=СУММПРОИЗВ((МУМНОЖ(--(Лист1!$B$2:$C$26=$A2:$B2);{1:1})=2)*(ГПР(Ч(ИНДЕКС(+Лист1!$E$2:$E$26;));Лист2!$B$1:$E$1;1)=C$1)*Лист1!$D$2:$D$26)

[[дата]:[дата]]

=СУММПРОИЗВ((Таблица17[@[Фамилия]:[Фамилия]]=Таблица18[[Фамилия]:[Фамилия]])*(Таблица17[[#Заголовки];[2018 ноябрь]]=Таблица18[[дата]:[дата]])*Таблица18[[сумма, руб]:[сумма, руб]])

=СУММПРОИЗВ(ЕСЛИОШИБКА(ТРАНСП(ОСТАТ(НАИМЕНЬШИЙ(СТРОКА(E7:G14)/1%+E7:G14;ЧИСЛСТОЛБ(E7:G14)*(СТРОКА(E7:E14)-6));100))/D3:K3;))

Function fx$(expr$, arg As Variant)
    With CreateObject("scriptcontrol")
        expr = Replace(Replace(Replace(expr, ChrW(923), "&&"), "V", "||"), "¬", "!")
        .Language = "JScript": fx = .Eval(Join(arg, ",") & "," & expr & "?1:0")
    End With
End Function

=fx(Z$7;B$7:D$7&"="&B14:D14)

Koriya    6 HINDI  621319

CHHATTISGARH 249632
Koriya       94653
Bharatpur    46439
Baikunthpur  7511

If lcase(FileItem.Name) like "*pdf" then

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dic As Object, arr1 As Variant, i&, j&, ar As Range, ac As Range
    If Not Intersect(Target, [A1:R35]) Is Nothing Then
        With Application
            Set ac = .ActiveCell
            Set dic = CreateObject("scripting.dictionary")
            .ScreenUpdating = 0
            .EnableEvents = 0
            .Undo 'отмена изменения
            With Target
                For Each ar In .Areas
                    i = i + 1
                    With ar
                        If .Count = 1 Then
                            ReDim arr1(1 To 1, 1 To 1)
                            arr1(1, 1) = .Value
                            dic(.Address) = arr1
                        Else
                            dic(.Address) = .Value
                        End If
                    End With
                Next
            End With
            .Undo 'отмена отмены изменения
            With Target
                For Each ar In .Areas
                    For i = 1 To ar.Rows.Count
                        For j = 1 To ar.Columns.Count
                            If dic(ar.Address)(i, j) <> ar.Cells(i, j) Then
                    With ar.Cells(i, j).Offset(, 19)
                    .Value = IIf(IsNumeric(.Value), .Value, 0) + 1
                    End With
                            End If
                Next j, i, ar
            End With
            ac.Activate
            .ScreenUpdating = 1
            .EnableEvents = 1
        End With
        Set dic = Nothing
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dic As Object, arr1 As Variant, i&, j&, ar As Range, ac As Range
    If Not Intersect(Target, [A1:R35]) Is Nothing Then
        With Application
            Set ac = .ActiveCell
            Set dic = CreateObject("scripting.dictionary")
            .ScreenUpdating = 0
            .EnableEvents = 0
            .Undo 'отмена изменения
            With Target
                For Each ar In .Areas
                    With ar
                        If .Count = 1 Then
                            ReDim arr1(1 To 1, 1 To 1)
                            arr1(1, 1) = .Value
                            dic(.Address) = arr1
                        Else
                            dic(.Address) = .Value
                        End If
                    End With
                Next
            End With
            .Undo 'отмена отмены изменения
            With Target
                For Each ar In .Areas
                    For i = 1 To ar.Rows.Count
                        For j = 1 To ar.Columns.Count
                            If dic(ar.Address)(i, j) <> ar.Cells(i, j) Then
                    ar.Cells(i, j).Offset(, 19) = 1
                            End If
                Next j, i, ar
            End With
            ac.Activate
            .ScreenUpdating = 1
            .EnableEvents = 1
        End With
        Set dic = Nothing
    End If
End Sub