ПОИСКПОЗ(H1;$A:$A)

ПОИСКПОЗ(H1;$A:$A;)

Public Sub Spl()
     Dim x, n&, i&
     Dim arr(), qwe()
     If Selection.Columns.Count > 1 Then Exit Sub
     Application.ScreenUpdating = 0
     n& = Selection.Rows.Count
     For i = n To 1 Step -1
         With Selection(i)
             x = Split(.Value, ", ")
             Dim r$: r = IIf(Application.ReferenceStyle = xlR1C1, "r", "")
             ReDim arr(0)
             Dim m&: m = 0
             For Each qq In x
                 m = m + 1
                 On Error Resume Next
                 qwe = Evaluate("row(" & Replace(qq, "-", r & ":") & IIf(InStr(1, qq, "-"), "", r & ":" & qq) & ")")
                 ReDim Preserve arr(UBound(arr) + UBound(qwe) + (m = 1))
                 For j = UBound(qwe) To 1 Step -1
                     arr(UBound(arr) - j + 1) = Application.Transpose(qwe)(UBound(qwe) - j + 1)
                 Next
             Next
             If Len(.Value) * UBound(arr) And Err.Number = 0 Then
                 Rows(.Row).Offset(1, 0).Resize(UBound(arr)).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
                 .EntireRow.Copy Rows(.Row).Offset(1, 0).Resize(UBound(arr))
                 Range(.Address).Resize(UBound(arr) + 1, 1).Value = WorksheetFunction.Transpose(arr)
             End If
         End With
     Next
     Application.ScreenUpdating = 1
End Sub

=COUNTAX(DISTINCT('Больничный_лист'[Сотрудники с больничным]);[Сотрудники с больничным])

=ЮНИСИМВ(8344)

=СЧЁТ(1/(B$1:B$21=B23)/(C$1:C$21="В"))

=COUNTAX(DISTINCT([Сотрудники с больничным]),[Сотрудники с больничным])

Sub qwe()
     Dim cn: Set cn = CreateObject("ADODB.Connection")
     Dim rs: Set rs = CreateObject("ADODB.Recordset")
     Dim prop: Set prop = cn.Properties
     cn.Provider = "Microsoft.Jet.OLEDB.4.0"
     prop("data source") = ThisWorkbook.FullName
     prop("Extended Properties") = "Excel 8.0;HDR=No;"
     cn.Open
     rs.Open "select f9, sum(f12), sum(F13)  from [за месяц$" & [данные].Address(0, 0) & "] group by F9", cn, 3, 3
     With Sheets("за месяц по нн").ListObjects("Таблица1")
         On Error Resume Next
         .DataBodyRange.Delete
         .ShowTotals = False
         .Range.Cells(2, 2).CopyFromRecordset rs
         .ShowTotals = True
     End With
     rs.Close: cn.Close: Set cn = Nothing: Set rs = Nothing
End Sub

=K5*(1-ПРОСМОТР(K5-1;{0;2;3;4;5;6;7;8;9;10}/1%%;{0;5;6;7;8;9;10;11;12;13})%)

     Dim ctrl As MSForms.Control
     For Each ctrl In Me.OLEObjects("frame1").Object.Controls
         If TypeOf ctrl Is MSForms.CheckBox Then ctrl.Value = True
     Next

Sub asd()
     Dim cbox As CheckBox
     For Each cbox In Worksheets("Лист1").CheckBoxes
         cbox.Value = True
     Next
End Sub

Option Explicit
Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                    Optional ByVal SearchDeep As Long = 999) As Collection
     ' Получает в качестве параметра путь к папке FolderPath,
     ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
     ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
     ' Возвращает коллекцию, содержащую полные пути найденных файлов
     ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)
      
     Dim FSO As Object
     Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
     Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
     GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
     Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function

Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                    ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
     ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
     ' перебор папок осуществляется в том случае, если SearchDeep > 1
     ' добавляет пути найденных файлов в коллекцию FileNamesColl
     Dim curfold As Object, fil As Object, sfol As Object
     On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
     If Not curfold Is Nothing Then    ' если удалось получить доступ к папке
         ' раскомментируйте эту строку для вывода пути к просматриваемой
         ' в текущий момент папке в строку состояния Excel
         ' Application.StatusBar = "Поиск в папке: " & FolderPath
         For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
             If fil.Name Like "*" & Mask Then FileNamesColl.Add fil '.path
         Next
         SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
         If SearchDeep Then    ' если надо искать глубже
             For Each sfol In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
             GetAllFileNamesUsingFSO sfol.path, Mask, FSO, FileNamesColl, SearchDeep
             Next
         End If
         Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
     End If
End Function

Sub sdf()
     Dim con: Set con = CreateObject("ADODB.Connection") 'подключение
     Dim RS: Set RS = CreateObject("ADODB.Recordset") 'рекордсет
     Dim ObjFile As Object
     Dim FilePath$, path$, ConnectionString$
      
     'Строка подключения
     ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & ";Extended Properties=dBASE IV"
     'ConnectionString = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=" & ThisWorkbook.path
      
     'открываем подключение
     con.Open ConnectionString$
      
     'создаем пустую временную базу данных dbf в папке с этим файлом
     con.Execute "create table atable (name Text(50), cnt long)"
      
     'перебираем найденные файлы dbf в папке с этим файлом и дочерних папках 1го уровня
     'если нужно искать в другой папке, то ее путь нужно указать вместо ThisWorkbook.path
     'например FilenamesCollection("C:\DBase\", ".dbf", 2)
     For Each ObjFile In FilenamesCollection(ThisWorkbook.path, ".dbf", 2)
         FilePath = ObjFile.path: path$ = Replace(FilePath, ObjFile.Name, "")
          
         'добавляем из каждого найденного файла группированные записи по первому полю в созданную временную базу
         con.Execute "INSERT INTO atable SELECT Field1 as name, sum(Field2) as cnt From " & ObjFile.Name & " IN '" & path & "' [Dbase IV;DATABASE=" & FilePath & "] group by Field1"
     Next
      
     'помещаем в рекордсет группированные записи из временной базы
     RS.Open "select name, sum(cnt) as sumcnt from atable group by name", con, 3, 3
      
     'выгружаем данные из рекордсета на лист
     [A1].CopyFromRecordset RS
      
     'закрываем рекордсет
     RS.Close
      
     'удаляем временную базу
     con.Execute "drop table atable"
      
     'закрвыаем подключение
     con.Close
     Set con = Nothing: Set RS = Nothing
End Sub

=СУММПРОИЗВ(ЕЧИСЛО(ПОИСК("*"&ПОВТОР((СТРОКА($1:$10)-1)&"*";СТОЛБЕЦ(СМЕЩ($A:$A;;;;ДЛСТР(H4))));H4))*(СТРОКА($1:$10)-1))

=ТЕКСТ(--(ПСТР(A2;ПОИСК(" ??,";A2)+1;2)&"."&ПОИСКПОЗ(;-ПОИСК(ТЕКСТ(СТРОКА($1:$12)*30;"[$-F1]МММ");A2))&"."&ПРАВБ(A2;13));"ДД.ММ.ГГГ ч:мм")

xlNumbers or xlTextValues or xlLogical or xlErrors