powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос
20 сообщений из 20, страница 1 из 1
Макрос
    #36544514
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добрый день!
Я экспортирую отчёт из аксеса в эксель,а в экселе надо его преобразовать в нужный вид(размер строк ,столбцов и закраска последних строк в группе отчета(несколько групп в отчёте)).Проблема в том что количество данных в отчёте может меняться и каждый раз он закрашивает не те строки,как сделать в макросе проверку какую строчку закрасить?
Пример:
Дата Тип машин Смена ...
F
F
F

B
B
B....
Последняя строчка группы пустая,может надо на это проверку поставить...??
...
Рейтинг: 0 / 0
Макрос
    #36544677
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SNikolai,

приложите лучше excel файлы с примером того что есть, и что нужно получить.
...
Рейтинг: 0 / 0
Макрос
    #36544739
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
вот в таком виде он из аксеса.
...
Рейтинг: 0 / 0
Макрос
    #36544779
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот так должен делать макрос.Там изменился размер строк ,некоторые закрасились,и добавилась строчка Total с формулой. Количество данных может меняться,поэтому надо как-то сделать чтоб он определял каую строчку красить и перед какой добавить строчку Total.Спасибо
...
Рейтинг: 0 / 0
Макрос
    #36544917
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SNikolai,

Ну можно например выполнить такой код:
Код: plaintext
1.
2.
3.
4.
With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns( 3 ))
  .FormatConditions.Delete
  .FormatConditions.Add Type:=xlExpression, Formula1:="=RC1=""Total"""
  .FormatConditions( 1 ).Font.Bold = True
End With

Макрос делает полужирным шрифт в третьем столбце активного листа по тем строкам в которых в первом столбце слово Total.
...
Рейтинг: 0 / 0
Макрос
    #36544967
Фотография big-duke
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Djon Player,

я делал так
1. Создать строку ( шаблон)
2. Отформатировать ее в нужном формате
3. Скрыть строку.
4. после вставки скопировать шаблон
5. вставить шаблон с указанием вставки только форматирования.
...
Рейтинг: 0 / 0
Макрос
    #36545039
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
big-duke,

Мой макрос просто добавляет условное форматирование по третьему столбцу в котором находятся итоговые суммы.
Можно и заранее установить условное форматирование на весь столбец и сделать файл в качестве шаблона.
Главное чтобы при экспорте данных из Access эти форматы не затёрлись.
...
Рейтинг: 0 / 0
Макрос
    #36545043
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
мне надо добавлять строчку тотал в конце каждой группы,как сделать чтоб макрос проверял определённую ячейку на ноль и если она ноль то перед ней добавлял строчку с тоталом??
...
Рейтинг: 0 / 0
Макрос
    #36545085
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ну или если взять этот код:

With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(3))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=RC1=""Total"""
.FormatConditions(1).Font.Bold = True
End With

что в нём исправить чтоб он не жирным выделял а добавлял строчку перед строчкой с тоталом?
...
Рейтинг: 0 / 0
Макрос
    #36545101
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub tt()
Dim sh As Worksheet
Dim iLastrow As Long
Dim i As Long
Set sh = Sheets( 1 )
iLastrow = sh.Cells(Rows.Count,  1 ).End(xlUp).Row
For i = iLastrow To  1  Step - 1 
If sh.Cells(i,  1 ) = "0" Then Cells(i,  1 ).EntireRow.Insert
Next i
End Sub

Проверяет А на 0.
...
Рейтинг: 0 / 0
Макрос
    #36545149
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
не очень понял как работает,в моей таблице он вообще ничего не делает,можете поподробней объяснить его смысл!спасибо
...
Рейтинг: 0 / 0
Макрос
    #36545153
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
А применительно к задача - надо проверять не на 0, а на пусто. И не до верха, а до 4 строки.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Sub tt()
Dim sh As Worksheet
Dim iLastrow As Long
Dim i As Long
Set sh = Sheets( 1 )
iLastrow = sh.Cells(Rows.Count,  4 ).End(xlUp).Row
For i = iLastrow +  1  To  4  Step - 1 
If sh.Cells(i,  4 ) = "" Then Cells(i,  1 ).EntireRow.Insert: Cells(i,  1 ).Value = "Total:"
Next i
End Sub
...
Рейтинг: 0 / 0
Макрос
    #36545160
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
А у Вас первый код ничего и не должен делать - там ведь нет "0" в столбце "A" :)
...
Рейтинг: 0 / 0
Макрос
    #36545163
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
гениально!Спасибо)
...
Рейтинг: 0 / 0
Макрос
    #36545174
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ещё один вопрос))как теперь в строчку с тоталом добавить в 3 ячейку формулу которая будет считать сумму ?
...
Рейтинг: 0 / 0
Макрос
    #36545252
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот народ ленивый пошёл...
Как я делал - включил запись макроса, сделал формулу, посмотрел, что получилось.
Получилось:
Код: plaintext
1.
    ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
Вставил это, немного видоизменив, в код:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub tt()
Dim sh As Worksheet
Dim iLastrow As Long
Dim i As Long
Set sh = Sheets( 1 )
iLastrow = sh.Cells(Rows.Count,  4 ).End(xlUp).Row
For i = iLastrow +  1  To  4  Step - 1 
If sh.Cells(i,  4 ) = "" Then Cells(i,  1 ).EntireRow.Insert: Cells(i,  1 ).Value = "Total:": Cells(i,  3 ).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
Next i
End Sub
...
Рейтинг: 0 / 0
Макрос
    #36545274
SNikolai
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
спасибо!я тоже так делал ,но тут маленькая проблема что формула тоже должна меняться в зависимости от кол-ва строк..(
...
Рейтинг: 0 / 0
Макрос
    #36545298
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SNikolai,
да, что-то упустил, извиняюсь. Надо подумать...
...
Рейтинг: 0 / 0
Макрос
    #36545797
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот, за один проход не получилось сделать через CurrentRegion, за три с раскраской сделал. И даже рамочку натянул - как бонус за ошибку с формулами :)
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
Sub SumAndGrey()
Dim sh As Worksheet
Dim iLastrow As Long
Dim i As Long
Dim sumstart As Integer
Application.ScreenUpdating = False

Set sh = Sheets( 1 )

iLastrow = sh.Cells(Rows.Count,  1 ).End(xlUp).Row
For i = iLastrow +  1  To  3  Step - 1 
If sh.Cells(i,  1 ) <> "" Then
Range(sh.Cells(i,  1 ), sh.Cells(i,  8 )).Interior.ColorIndex =  48 

End If
Next i

iLastrow = sh.Cells(Rows.Count,  4 ).End(xlUp).Row
For i = iLastrow +  1  To  4  Step - 1 
If sh.Cells(i,  4 ) = "" Then
Cells(i,  1 ).EntireRow.Insert
End If
Next i

iLastrow = sh.Cells(Rows.Count,  4 ).End(xlUp).Row
For i = iLastrow +  1  To  4  Step - 1 
If sh.Cells(i,  1 ) = "" And sh.Cells(i,  2 ) = "" Then
Set tbl = Range(Cells(i -  1 ,  2 ), Cells(i -  1 ,  2 )).CurrentRegion
Cells(i,  1 ).Value = "Total": Cells(i,  3 ).FormulaR1C1 = "=SUM(R[-" & tbl.Rows.Count -  1  & "]C:R[-1]C)"
End If
Next i
Set tbl = Range(Cells( 2 ,  1 ), Cells( 2 ,  1 )).CurrentRegion
tbl.Offset( 1 ,  0 ).Resize(tbl.Rows.Count -  1 , _
tbl.Columns.Count).Select
Selection.EntireColumn.AutoFit

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With


With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns( 3 ))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=RC1=""Total"""
.FormatConditions( 1 ).Font.Bold = True
End With

Range("A1").Select
Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Макрос
    #36545823
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Кстати, про группировку забыл.
Вставьте перед With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(3)):

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
    With ActiveSheet.Outline
'        .AutomaticStyles = True
        .SummaryRow = xlBelow
        .SummaryColumn = xlLeft
    End With
'    ActiveSheet.Outline.AutomaticStyles = True
    Selection.AutoOutline
Там можно поиграться с комментарием - добавить/убрать. Правда, автомат глючит на строках, где всего одно слагаемое, там руками добавить группировку надо.
...
Рейтинг: 0 / 0
20 сообщений из 20, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]