#!/bin/bash # Год, где находятся папки с месяцами YEAR="2025" # Определение текущего месяца CURRENT_MONTH=$(date +"%m") # Путь к папке текущего месяца MONTH_DIR="$YEAR/$CURRENT_MONTH" # Папка шаблон в папке с месяцем TEMPLATE_DIR="$MONTH_DIR/шаблон" # Проверка существования папки месяца и шаблона if [ ! -d "$MONTH_DIR" ]; then echo "Папка месяца '$MONTH_DIR' не найдена. Завершение работы." exit 1 fi if [ ! -d "$TEMPLATE_DIR" ]; then echo "Папка шаблон '$TEMPLATE_DIR' не найдена. Завершение работы." exit 1 fi # Находим все существующие папки с датами в текущем месяце EXISTING_FOLDERS=$(ls -1 "$MONTH_DIR" | grep -E "^[0-3][0-9]\.[0-1][0-9]\.[0-9]{4}$" | sort) # Если таких папок нет, создаем первую папку на основе текущей даты if [ -z "$EXISTING_FOLDERS" ]; then NEW_DATE=$(date +"%d.%m.%Y") else # Если папки есть, находим последнюю дату LAST_DATE=$(echo "$EXISTING_FOLDERS" | tail -n 1) # Вычисляем следующую дату NEW_DATE=$(date -d "$LAST_DATE +1 day" +"%d.%m.%Y") fi # Путь для новой папки NEW_FOLDER="$MONTH_DIR/$NEW_DATE" # Проверяем, существует ли уже папка с новой датой if [ -d "$NEW_FOLDER" ]; then echo "Папка '$NEW_FOLDER' уже существует. Завершение работы." exit 1 fi # Копируем шаблон в новую папку cp -r "$TEMPLATE_DIR" "$NEW_FOLDER" if [ $? -eq 0 ]; then echo "Папка '$NEW_FOLDER' успешно создана." else echo "Ошибка при копировании шаблона." exit 1 fi Sub TransformTable() Dim ws As Worksheet Dim dict As Object Dim lastRow As Long, lastCol As Long Dim dataRange As Range, cell As Range Dim rowIndex As Long, colIndex As Long Dim dateDict As Object Dim idList As Object Dim dateKey As String, idKey As String Set ws = ActiveSheet Set dict = CreateObject("Scripting.Dictionary") Set dateDict = CreateObject("Scripting.Dictionary") Set idList = CreateObject("Scripting.Dictionary") lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Читаем данные в словарь For rowIndex = 2 To lastRow dateKey = ws.Cells(rowIndex, 1).Value idKey = ws.Cells(rowIndex, 2).Value If Not dict.exists(dateKey) Then Set dict(dateKey) = CreateObject("Scripting.Dictionary") End If dict(dateKey)(idKey) = ws.Cells(rowIndex, 3).Value ' Список уникальных дат и id If Not dateDict.exists(dateKey) Then dateDict(dateKey) = 1 If Not idList.exists(idKey) Then idList(idKey) = 1 Next rowIndex ' Заголовки ws.Cells(1, 1).Value = "Дата" colIndex = 2 For Each idKey In idList.keys ws.Cells(1, colIndex).Value = idKey colIndex = colIndex + 1 Next idKey ' Заполняем новую таблицу rowIndex = 2 For Each dateKey In dateDict.keys ws.Cells(rowIndex, 1).Value = dateKey colIndex = 2 For Each idKey In idList.keys If dict(dateKey).exists(idKey) Then ws.Cells(rowIndex, colIndex).Value = dict(dateKey)(idKey) Else ws.Cells(rowIndex, colIndex).Value = "" End If colIndex = colIndex + 1 Next idKey rowIndex = rowIndex + 1 Next dateKey ' Форматируем lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ws.Range(ws.Cells(1, 1), ws.Cells(rowIndex - 1, lastCol)).Columns.AutoFit MsgBox "Преобразование завершено!", vbInformation End Sub On Error GoTo ErrorHandler cmd.Execute MsgBox "Команда выполнена успешно!" Exit Sub ' Выход, если ошибки нет ErrorHandler: MsgBox "Ошибка выполнения: " & Err.Number & " - " & Err.Description Err.Clear Resume Next
Sub HighlightDuplicates() Dim ws As Worksheet Dim rng As Range, cell As Range Dim dict As Object ' Устанавливаем рабочий лист и диапазон (выделенный пользователем) Set ws = ActiveSheet On Error Resume Next Set rng = Application.Selection On Error GoTo 0 If rng Is Nothing Then MsgBox "Выберите диапазон для анализа!", vbExclamation Exit Sub End If ' Создаем объект словаря для хранения частоты значений Set dict = CreateObject("Scripting.Dictionary") ' Заполняем словарь частотой значений For Each cell In rng If Not IsEmpty(cell.Value) Then If dict.exists(cell.Value) Then dict(cell.Value) = dict(cell.Value) + 1 Else dict.Add cell.Value, 1 End If End If Next cell ' Применяем форматирование к повторяющимся значениям For Each cell In rng If Not IsEmpty(cell.Value) Then If dict(cell.Value) > 1 Then cell.Interior.Color = RGB(255, 200, 200) ' Светло-красный фон Else cell.Interior.ColorIndex = xlNone ' Убираем формат, если не дубликат End If End If Next cell ' Очистка объектов Set dict = Nothing Set rng = Nothing Set ws = Nothing End Sub