Архивы автора: kos20

Sub RenameFoldersInFolders()
    Dim parentFolderPath As String
    Dim fso As Object
    Dim parentFolder As Object
    Dim subFolder As Object
    Dim newFolderName As String
    Dim counter As Integer
    
    ' Укажите путь к родительской папке, в которой находятся подпапки
    parentFolderPath = "R:\ххххх\_Новая\ПАПКА" ' Измените на путь к вашей родительской папке
    
    ' Создаем объект FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Проверяем, существует ли родительская папка
    If Not fso.FolderExists(parentFolderPath) Then
        MsgBox "Родительская папка не найдена!"
        Exit Sub
    End If
    
    ' Открываем родительскую папку
    Set parentFolder = fso.GetFolder(parentFolderPath)
    
    ' Счетчик для создания уникальных имен
    counter = 1
    
    ' Перебираем все подпапки в родительской папке
    For Each subFolder In parentFolder.Subfolders
        ' Пример нового имени папки: "Folder_1", "Folder_2" и так далее
'        newFolderName = "Folder_" & counter
        
        CurentName = subFolder.Name
        newName = Replace(CurentName, "++", "")
         If subFolder.Name <> newName Then subFolder.Name = newName
        
        ' Переименовываем папку
'        Name parentFolderPath & CurentName as & "\" & newFolderName
'        subFolder = parentFolderPath & "\" & newFolderName
        
        ' Увеличиваем счетчик
        counter = counter + 1
    Next subFolder

    MsgBox "Переименование папок завершено!"
End Sub

Sub ДвоичныйПоиск()
    
    txtFind = "01.02.2023"
    
    first = 1
    last = 51
    Length = 50
    half0 = 26
    i = 1
    Length = first + last
    Do While last >= first
        half = Round((first + last) / 2)
        
       If Range("B" & half) = CDate(txtFind) Then
          For Row = half To 50
            If Range("B" & Row) <> CDate(txtFind) Then
                xx = Row
                Exit For
            End If
          Next Row
        Debug.Print "Кол-во операций: " & i & " последний элемент " & xx - 1
        Exit Sub
       End If
        
        If Range("B" & half).Value > CDate(txtFind) Then    'Range("B" & half) > txtFind   'DateDiff("d", txtFind, Range("B" & half)) > 0
            last = half - 1
        Else
            first = half + 1
        End If
    i = i + 1
    Loop
    
    
    
    Debug.Print "Значение не найдено. Кол-во операций " & i
End Sub

Процедура НайтиГаражНажатие(Элемент)
	// Вставить содержимое обработчика.
	Если ПустаяСтрока(ТекущееНазвание)  тогда
		возврат;
	конецЕсли;
	
	Гараж = Справочники.спГараж.НайтиПоНаименованию(ТекущееНазвание,Истина);
КонецПроцедуры