' В начале EndReport:
Dim plusCells() As Variant
Dim plusCount As Long
plusCount = 0
' ... в цикле колонки K (11) добавляем:
If IsNumeric(x) And nrt0 = nrt And x <> "" Then
plusCount = plusCount + 1
ReDim Preserve plusCells(1 To plusCount)
plusCells(plusCount) = nrt0
End If
' ... в самом конце EndReport, перед MergeForPages:
If plusCount > 0 Then
Application.ScreenUpdating = False
For i = 1 To plusCount
Dim plusCell As Range
Dim targetCell As Range
Dim plusSign As Shape
Set plusCell = Sheets(1).Cells(plusCells(i), 10)
Set targetCell = Sheets(1).Cells(plusCells(i), 11)
' Получаем точные координаты
Dim plusLeft As Double
Dim plusTop As Double
plusLeft = plusCell.Left + (plusCell.Width / 2) - 3 ' Центрируем по горизонтали
plusTop = targetCell.Top + targetCell.Height + 2 ' +2 пикселя ниже границы
Set plusSign = Sheets(1).Shapes.AddTextbox(msoTextOrientationHorizontal, _
plusLeft, _
plusTop, _
6, 6)
With plusSign
.Name = "PlusSign_R" & plusCells(i) & "_C10"
.TextFrame.Characters.Text = "+"
With .TextFrame.Characters.Font
.Size = 6
.Name = "Arial"
.Bold = True
End With
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.Placement = xlFreeFloating
End With
Next i
Application.ScreenUpdating = True
End IfДобавлено (2025-09-04, 08:03)
---------------------------------------------
' Обработка колонки J (10)
nrt = 4
While nrt < ent
nrt0 = nrt
nrt = nrt + 1
While nrt < ent And Sheets(1).Cells(nrt, 10).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then nrt = nrt - 1
' НЕ очищаем ячейки с плюсами!
If Sheets(1).Cells(nrt0, 10).Value <> "+" Then
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).ClearContents
End If
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).Merge
' Для ячеек с плюсом сохраняем специальное форматирование
If Sheets(1).Cells(nrt0, 10).Value = "+" Then
With Sheets(1).Cells(nrt0, 10)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Font.Size = 8
.Font.Bold = True
' Добавляем отступ снизу
.Top = .Top + .Height - 12 ' Смещаем вниз
End With
Else
Sheets(1).Cells(nrt0, 10).Value = Sheets(1).Cells(nrt, 10).Value
End If
nrt = nrt + 1
Wend
Добавлено (2025-09-04, 08:07)
---------------------------------------------
' В цикле обработки колонки 10:
If Sheets(1).Cells(nrt0, 10).Value = "+" Then
With Sheets(1).Cells(nrt0, 10)
.Value = "+"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Font.Size = 8
.Font.Bold = True
' Добавляем нижний отступ через высоту шрифта
.Top = .Top + .Height - 10
End With
End If
Добавлено (2025-09-04, 08:18)
---------------------------------------------
' ... предыдущий код для колонки 11 ...
' === НОВЫЙ БЛОК: ОБРАБОТКА ПРОБ В КОЛОНКЕ 11 И ДОБАВЛЕНИЕ "+" В КОЛОНКЕ 10 ===
nrt = 4
While nrt < ent
nrt0 = nrt
nrt = nrt + 1
' Пропускаем пустые ячейки в колонке 11
While nrt < ent And Sheets(1).Cells(nrt, 11).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then nrt = ent - 1
' Определяем размер блока
blockHeight = nrt - nrt0 + 1
' Получаем значение из колонки 11
cellValue = Sheets(1).Cells(nrt0, 11).Value
' Проверяем: если блок высотой 1 строка и значение - число, добавляем "+"
If blockHeight = 1 And IsNumeric(cellValue) And cellValue <> "" Then
' Добавляем "+" в колонку 10 со смещением вниз (2 перевода строки)
Sheets(1).Cells(nrt0, 10).Value = Chr(10) & Chr(10) & "+"
Sheets(1).Cells(nrt0, 10).HorizontalAlignment = xlCenter
Sheets(1).Cells(nrt0, 10).VerticalAlignment = xlTop
End If
nrt = nrt + 1
Wend
' Теперь выполняем объединение для колонки 10 аналогично колонке 11
nrt = 4
While nrt < ent
nrt0 = nrt
nrt = nrt + 1
' Пропускаем пустые ячейки в колонке 10
While nrt < ent And Sheets(1).Cells(nrt, 10).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then nrt = ent - 1
' Объединяем ячейки в колонке 10
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).ClearContents
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).Merge
' Восстанавливаем значение из первой ячейки блока
originalValue = Sheets(1).Cells(nrt0, 10).Value
Sheets(1).Cells(nrt0, 10).Value = originalValue
Sheets(1).Cells(nrt0, 10).HorizontalAlignment = xlCenter
Sheets(1).Cells(nrt0, 10).VerticalAlignment = xlTop
' Убираем нижнюю границу как в колонке 11
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
nrt = nrt + 1
Wend
' ... следующий код для колонки 12 ...
Добавлено (2025-09-04, 08:23)
---------------------------------------------
' === БЛОК: ОБРАБОТКА ПРОБ В КОЛОНКЕ 11 И ДОБАВЛЕНИЕ "+" В КОЛОНКЕ 10 ===
nrt = 4
While nrt < ent
nrt0 = nrt
' Ищем начало блока в колонке 11
While nrt < ent And Sheets(1).Cells(nrt, 11).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then Exit While
nrt0 = nrt ' Начало блока с данными
' Ищем конец блока в колонке 11
current_value = Sheets(1).Cells(nrt, 11).Value
nrt = nrt + 1
While nrt < ent And Sheets(1).Cells(nrt, 11).Value = ""
nrt = nrt + 1
Wend
' Проверяем, не вышли ли за пределы
If nrt >= ent Then nrt = ent - 1
' Определяем размер блока
blockHeight = nrt - nrt0 + 1
cellValue = Sheets(1).Cells(nrt0, 11).Value
' ДИАГНОСТИКА - можно удалить после отладки
Debug.Print "Блок в колонке 11: строка " & nrt0 & ", высота " & blockHeight & ", значение: '" & cellValue & "'"
' Проверяем условия для добавления "+"
If blockHeight = 1 And IsNumeric(cellValue) And cellValue <> "" Then
' ДИАГНОСТИКА
Debug.Print "Добавляем '+' в колонку 10, строка " & nrt0
' Добавляем "+" в колонку 10 со смещением вниз
Sheets(1).Cells(nrt0, 10).Value = Chr(10) & Chr(10) & "+"
Sheets(1).Cells(nrt0, 10).HorizontalAlignment = xlCenter
Sheets(1).Cells(nrt0, 10).VerticalAlignment = xlTop
' Форматирование "+"
With Sheets(1).Cells(nrt0, 10).Font
.Bold = True
.Color = RGB(255, 0, 0) ' Красный цвет
.Size = 10
End With
End If
nrt = nrt + 1
Wend
' === ОБЪЕДИНЕНИЕ ЯЧЕЕК В КОЛОНКЕ 10 ===
nrt = 4
While nrt < ent
nrt0 = nrt
' Пропускаем пустые ячейки в колонке 10
While nrt < ent And Sheets(1).Cells(nrt, 10).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then Exit While
' Запоминаем значение первой ячейки (может содержать "+")
originalValue = Sheets(1).Cells(nrt, 10).Value
' Ищем конец блока
nrt = nrt + 1
While nrt < ent And Sheets(1).Cells(nrt, 10).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then nrt = ent - 1
' Объединяем ячейки в колонке 10
If nrt > nrt0 Then
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).Merge
End If
' Восстанавливаем значение и выравнивание
Sheets(1).Cells(nrt0, 10).Value = originalValue
Sheets(1).Cells(nrt0, 10).HorizontalAlignment = xlCenter
Sheets(1).Cells(nrt0, 10).VerticalAlignment = xlTop
' Убираем нижнюю границу
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
nrt = nrt + 1
Wend
Добавлено (2025-09-04, 08:28)
---------------------------------------------
' === БЛОК: ОБРАБОТКА ПРОБ В КОЛОНКЕ 11 И ДОБАВЛЕНИЕ "+" В КОЛОНКЕ 10 ===
nrt = 4
While nrt < ent
nrt0 = nrt
' Ищем начало блока в колонке 11
While nrt < ent And Sheets(1).Cells(nrt, 11).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then Exit Do ' Выход из цикла While
nrt0 = nrt ' Начало блока с данными
' Ищем конец блока в колонке 11
current_value = Sheets(1).Cells(nrt, 11).Value
nrt = nrt + 1
While nrt < ent And Sheets(1).Cells(nrt, 11).Value = ""
nrt = nrt + 1
Wend
' Проверяем, не вышли ли за пределы
If nrt >= ent Then nrt = ent - 1
' Определяем размер блока
blockHeight = nrt - nrt0 + 1
cellValue = Sheets(1).Cells(nrt0, 11).Value
' ДИАГНОСТИКА - можно удалить после отладки
Debug.Print "Блок в колонке 11: строка " & nrt0 & ", высота " & blockHeight & ", значение: '" & cellValue & "'"
' Проверяем условия для добавления "+"
If blockHeight = 1 And IsNumeric(cellValue) And cellValue <> "" Then
' ДИАГНОСТИКА
Debug.Print "Добавляем '+' в колонку 10, строка " & nrt0
' Добавляем "+" в колонку 10 со смещением вниз
Sheets(1).Cells(nrt0, 10).Value = Chr(10) & Chr(10) & "+"
Sheets(1).Cells(nrt0, 10).HorizontalAlignment = xlCenter
Sheets(1).Cells(nrt0, 10).VerticalAlignment = xlTop
' Форматирование "+"
With Sheets(1).Cells(nrt0, 10).Font
.Bold = True
.Color = RGB(255, 0, 0) ' Красный цвет
.Size = 10
End With
End If
nrt = nrt + 1
Wend
' === ОБЪЕДИНЕНИЕ ЯЧЕЕК В КОЛОНКЕ 10 ===
nrt = 4
While nrt < ent
nrt0 = nrt
' Пропускаем пустые ячейки в колонке 10
While nrt < ent And Sheets(1).Cells(nrt, 10).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then Exit Do ' Выход из цикла While
' Запоминаем значение первой ячейки (может содержать "+")
originalValue = Sheets(1).Cells(nrt, 10).Value
' Ищем конец блока
nrt = nrt + 1
While nrt < ent And Sheets(1).Cells(nrt, 10).Value = ""
nrt = nrt + 1
Wend
If nrt >= ent Then nrt = ent - 1
' Объединяем ячейки в колонке 10
If nrt > nrt0 Then
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).Merge
End If
' Восстанавливаем значение и выравнивание
Sheets(1).Cells(nrt0, 10).Value = originalValue
Sheets(1).Cells(nrt0, 10).HorizontalAlignment = xlCenter
Sheets(1).Cells(nrt0, 10).VerticalAlignment = xlTop
' Убираем нижнюю границу
Sheets(1).Range(Cells(nrt0, 10), Cells(nrt, 10)).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
nrt = nrt + 1
Wend
