Private Sub ComboBox1_Enter()

Private Sub AddListItem_t()
On Error Resume Next
ListBox1.Clear
With Worksheets("Лист3")
    Me.ListBox1.List = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
End With
End Sub

Sub Макрос1()
On Error Resume Next
Application.EnableEvents = False
    Range("D5:D15, D17, D18, D20, D21, D20:D32, D35:D40, D44:D50, D53, D55, D57, D61:D65, D69:D73, D76:D87, D89:D99, D103:D108, D110, D111, D113, D114, D116, D118, D119, D121:D126, D129:D132, D136:D138, D140, D142:D146, D149:D163") = "0"
    Sheets("Шаблон").Range("A2:F45").ClearContents
Application.EnableEvents = True
End Sub

Private Sub CommandButton1_Click()
Dim iLastRow&, I&, J&, N&
On Error Resume Next
ReDim arr(0 To Me.ListBox1.ListCount - 1, 0 To 6)
For I = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(I) Then
        arr(N, 0) = Me.TextBox1
        arr(N, 1) = Me.ComboBox1
        For J = 1 To 5
            arr(N, J + 1) = Me.ListBox1.List(I, J)
        Next
        N = N + 1
    End If
Next
If N <> Empty Then
    With Worksheets("Итоги")
        iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(iLastRow, 1).Resize(N, 7) = arr
    End With
End If
End Sub

saldo = CDbl(TextBox7.Value)

On Error Resume Next

Dim n As Integer

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each cell In Target
   If Not Intersect(cell, Range("O2:O200")) Is Nothing Then
        With cell.Offset(0, -14)
           .Value = Now
           .EntireColumn.AutoFit
        End With
   End If
Next cell
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n As Integer
If Target.Count > 1 Then Exit Sub
On Error Resume Next
n = Target.Validation.Type
If n = 3 Then Application.SendKeys "%{DOWN}"
On Error GoTo 0
End Sub

=(C6+E6)-(B6+D6)

Sub TextToCells2D()
Dim arr(), arrNew(), I&, J, K&, N&
dlm = Application.InputBox("Разделитель:")
If Selection.Count = 1 Then
    ReDim arr(1 To 1, 1 To 1)
    arr(1, 1) = Selection.Value
Else
    arr = Selection.Value
End If
ReDim arrNew(0 To UBound(arr, 2) - 1, 0 To 0)
For I = 1 To UBound(arr, 2)
    For J = 1 To UBound(arr)
        If arr(J, I) <> Empty Then
            iStr = Split(arr(J, I), dlm)
            For N = 0 To UBound(iStr)
                If UBound(arrNew, 2) < K Then ReDim Preserve arrNew(0 To UBound(arr, 2) - 1, 0 To K)
                arrNew(I - 1, K) = Trim(iStr(N))
                K = K + 1
            Next
        End If
    Next
    K = Empty
Next
Selection(1).Resize(UBound(arrNew, 2) + 1, UBound(arrNew, 1) + 1) = Application.Transpose(arrNew)
End Sub

Sub TextToCells2D()
Dim arr, arrNew(), I&, J, K&, N&
dlm = Application.InputBox("Разделитель:")
arr = Selection.Value
For I = 1 To UBound(arr, 2)
    For J = 1 To UBound(arr)
        If arr(J, I) <> Empty Then
            iStr = Split(arr(J, I), dlm)
            For N = 0 To UBound(iStr)
                ReDim Preserve arrNew(0 To 100, 0 To K)
                arrNew(N, K) = Trim(iStr(N))
            Next
            K = K + 1
        End If
    Next
Next
Range("I1").Resize(UBound(arrNew, 1) + 1, K) = arrNew
End Sub

clAddress = Range("$B$7:$B$204").Find(Cells(1, 1).Value).Address

Sub adapt()
Dim Arrad(), I&
Arrad = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).Value
For I = 1 To UBound(Arrad)
    If I Mod 2 = 0 Then
        Cells(I, 9) = "Текст Другой" & Arrad(I, 1) & "Текст Другой"
    Else
        Cells(I, 9) = "Текст Текст" & Arrad(I, 1) & "Текст Текст"
    End If
Next
End Sub