Антон Федорян

Sub PrintWorkDays()
    Dim Counter As Long
    
    Counter = 1
    For i = Range("A1") To Range("B1")
        Select Case Weekday(i)
            Case 2 To 6
                Cells(Counter, 3).Value = i
                Counter = Counter + 1
            Case Else
        End Select
    Next i
End Sub

Sub duplicate()
    Dim StrIn As String
    Dim StrOut As String
    Dim Symbol As String
    Dim Twice As Boolean
    
    StrIn = "835*23*2"
    Symbol = "2"
    StrOut = ""
    
    If InStr(StrIn, Symbol) > 0 Then
        Twice = True
    Else
        Twice = False
    End If
    
    For i = 1 To Len(StrIn)
        Char = Mid(StrIn, i, 1)
        Select Case Char
            Case Symbol
                StrOut = StrOut & Char
            Case "*"
                StrOut = StrOut
            Case Else
                StrOut = StrOut & Char
                If Twice Then
                    StrOut = StrOut & Char
                End If
        End Select
    Next i
    
    MsgBox (StrOut)
End Sub

Sub order()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim objRegExp As New RegExp
    Dim pattern As String
    Dim Dict As New Dictionary
    Dim ResRow As Integer
    Dim NumOrder As Integer
    
    
    Set WB = Excel.ActiveWorkbook
    Set WS = WB.ActiveSheet
    
    ' Ищем только цифры
    pattern = "\d+"
    
    With objRegExp
        .Global = True
        .IgnoreCase = True
        .pattern = pattern
        .MultiLine = True
    End With
    
    ' Номер строки, с которой начинается запись результатов
    ResRow = 10
    ' Проходим со 2 по 5 строки с заказами
    For r = 2 To 5
        ' 2 - столбец с номерами заказов
        Set objMatches = objRegExp.Execute(WS.Cells(r, 2))
        For i = 0 To objMatches.Count - 1
            Set objMatch = objMatches.Item(i)
            NumOrder = objMatch.Value
            
            ' Если номер заказа раньше не встречался
            If Not Dict.Exists(NumOrder) Then
                Dict.Add NumOrder, ResRow
                ' Пишем в 1 столбец номер заказа
                WS.Cells(ResRow, 1) = NumOrder
                ResRow = ResRow + 1
            End If
            
            ' Выписываем номера покупателей
            If IsEmpty(WS.Cells(Dict.Item(NumOrder), 2)) Then
                WS.Cells(Dict.Item(NumOrder), 2) = WS.Cells(r, 1)
            Else
                WS.Cells(Dict.Item(NumOrder), 2) = WS.Cells(Dict.Item(NumOrder), 2) & ", " & WS.Cells(r, 1)
            End If
        Next i
    Next r
    
    Set objRegExp = Nothing
End Sub

Public Function Encrypt(pass As String, login As String)
    Dim PassLength As Integer
    Dim r, c, z As Integer
    Dim encrypt_str As String
    Dim ps, ls As String
    
    PassLength = 16
    encrrypt_str = ""

    For i = 0 To PassLength - 1
        ps = Mid(pass, (i Mod Len(pass)) + 1, 1)
        ls = Mid(login, (i Mod Len(login)) + 1, 1)
        
        For j = 1 To 39
            For k = 1 To 3
                If (Worksheets("table").Cells(j, k) = ps) Then
                    r = j
                    c = k
                    Exit For
                End If
            Next k
        Next j
            
        For l = 4 To 39
            If (Worksheets("table").Cells(r, l) = ls) Then
                z = l
                Exit For
            End If
        Next l
        encrrypt_str = encrrypt_str & Worksheets("table").Cells(c, z)
    Next i

    Encrypt = encrrypt_str
End Function

Sub filter()
    Dim one As Integer
    Dim c As Variant
    one = 0
    For Each c In ActiveWorkbook.Worksheets("Лист1").Range("C6:C19")
        If (c <> "") And (Rows(c.Row).Hidden = False) Then
            one = one + Int(c)
        End If
    Next
    MsgBox (Str(one))
End Sub

Private Sub Check_Click()
    Dim cost, quantity, summ, made, total As Double
    
    cost = Val(UserForm1.tCost.Text)
    quantity = Val(UserForm1.tQuantity.Text)
    made = Val(UserForm1.tMade.Text)
    
    summ = cost * quantity
    UserForm1.lSum.Caption = Str(summ)
    
    total = made - summ
    UserForm1.lTotal.Caption = Str(total)
End Sub

Sub test()
    Dim d As Date
    d = DateAdd("d", 90, Now)
    Selection.TypeText (d)
End Sub