powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Обработка данных xls для создания отчета в xls
25 сообщений из 30, страница 1 из 2
Обработка данных xls для создания отчета в xls
    #37658182
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Hi ALL
Помогите модифицировать код для формирования отчета, из выгруженных данных… чтобы было применимо к любому размеру данных…
В идеале сделать на первом листе кнопку и вызывать диалог для открытия (источника данных) xls файл (эти данные представлены на лист1) и соответственно моему быдлокоду(макрос3 в файле), по моДИФИКАЦИИ их в отчет вида… (см. вложение также лист 4) в разбивке по видам установок с добавлением доп. полей… и под итогов …

Плз. комментируйте предлагаемый код хотя бы по минимуму т.к. иначе я не разберусь… Весь мой код основывается на записи макросов…

Огромное спасибо за любую помощь!.
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37658196
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Честно говоря - даже лень скачивать ваш проект и разбираться...
Посмотрите сначала, что хотя бы сделано там - 11333174 и далее по треду.
Если будут акие-то конкретные проблему - тогда уж спрашивайте.
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37658323
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hi AndreTM
пример, скачал буду разбираться применительно к моей задаче...
НО хотелось бы увидеть констуртивные советы непосредственно моего кода.

Перенесено в Офис по просьбе автора.

Модератор: Тема перенесена из форума "Visual Basic".
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37658892
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не, ну мы можем за вас сделать. Небесплатно. Потому что вы предлагаете именно "сделать за вас", а не "помочь конкретно, где не получается".
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37659039
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Уважаемый AndreTM ВЫ даже не качали файло не смотрели код, не дали не единого комментария моему коду, а хотите денег...

КОД
Код: vbnet
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.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
Sub Ìàêðîñ3()
'
' Ìàêðîñ3 Ìàêðîñ
'
    Application.ScreenUpdating = False
'Ôèëüòð íà íåñîîòâåòñòâèå
    ActiveSheet.Range("$A$1:$F$2098").AutoFilter Field:=1, Criteria1:="=41**", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$F$2098").AutoFilter Field:=2, Criteria1:="<>"
    Columns("A:F").Select
    Range("A170").Activate
    Selection.Copy
'&#194;&#241;&#242;&#224;&#226;&#235;&#255;&#229;&#236; &#226; &#235;&#232;&#241;&#242;2
    Sheets("&#203;&#232;&#241;&#242;2").Select
    Range("A1").Select
    ActiveSheet.Paste
'&#207;&#238;&#228;&#242;&#255;&#227;&#232;&#226;&#224;&#229;&#236; &#231;&#237;&#224;&#247;&#229;&#237;&#232;&#255; &#232;&#231; &#241;&#239;&#240;&#224;&#226;&#238;&#247;&#237;&#232;&#234;&#224;
    Range("E1:E1301").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],&#209;&#239;&#240;&#224;&#226;&#238;&#247;&#237;&#232;&#234;!R1C1:R22C2,2)"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E1301"), Type:=xlFillDefault
    Range("E2:E1301").Select
'&#202;&#238;&#239;&#232;&#240;&#243;&#229;&#236; &#232; &#226;&#241;&#242;&#224;&#226;&#235;&#255;&#229;&#236; &#231;&#237;&#224;&#247;&#229;&#237;&#232;&#255;
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
'&#226;&#241;&#242;&#224;&#226;&#235;&#255;&#229;&#236; &#239;&#240;&#238;&#236;&#229;&#230;&#243;&#242;&#238;&#247;&#237;&#251;&#229; &#232;&#242;&#238;&#227;&#232;
    'Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6), _
    'Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
' &#207;&#240;&#238;&#247;&#232;&#229;
'
    Sheets.Add
    ActiveSheet.Name = "&#207;&#240;&#238;&#247;&#232;&#229;"
    Range("A1").Select
    Sheets("&#203;&#232;&#241;&#242;2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=005", Operator:=xlOr, Criteria2:= _
        "=009"
    Selection.Copy
    Sheets("&#207;&#240;&#238;&#247;&#232;&#229;").Select
    ActiveSheet.Paste
'&#194;&#241;&#242;&#224;&#226;&#235;&#255;&#229;&#236; &#244;&#238;&#240;&#236;&#243;&#235;&#251;
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
    Selection.NumberFormat = "General"

    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Selection.NumberFormat = "0.00%"
    
    Range("H2:I2").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("H2:I750"), Type:=xlFillDefault
    Range("H2:I750").Select

' &#193;&#254;&#228;&#230;&#229;&#242;
'
    Sheets.Add
    ActiveSheet.Name = "&#193;&#254;&#228;&#230;&#229;&#242;"
    Range("A1").Select
    Sheets("&#203;&#232;&#241;&#242;2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=010"
    Selection.Copy
    Sheets("&#193;&#254;&#228;&#230;&#229;&#242;").Select
    ActiveSheet.Paste
    
' &#209;&#229;&#235;&#252;&#245;&#238;&#231;
'
    Sheets.Add
    ActiveSheet.Name = "&#209;&#229;&#235;&#252;&#245;&#238;&#231;"
    Range("A1").Select
    Sheets("&#203;&#232;&#241;&#242;2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=011"
    Selection.Copy
    Sheets("&#209;&#229;&#235;&#252;&#245;&#238;&#231;").Select
    ActiveSheet.Paste
    
    
' &#205;&#224;&#241;&#229;&#235;&#229;&#237;&#232;&#229;
'
    Sheets.Add
    ActiveSheet.Name = "&#205;&#224;&#241;&#229;&#235;&#229;&#237;&#232;&#229;"
    Range("A1").Select
    Sheets("&#203;&#232;&#241;&#242;2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:=Array( _
        "012", "013", "014", "015", "016", "017"), Operator:=xlFilterValues
    Selection.Copy
    Sheets("&#205;&#224;&#241;&#229;&#235;&#229;&#237;&#232;&#229;").Select
    ActiveSheet.Paste
        
        
    Application.ScreenUpdating = True
End Sub


Интересует как работать с ActiveSheet.Range("$A$1:$G$1301") - можно вычислить если список изменяется всякий раз при выгрузке, становится больше или меньше?
вставка формул ActiveCell.FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1" она получается строго привязана к ячейкам. можно как то унифицировать? Вычислить последний столбик заполнений данными, и вставить соответствующий столбцы с формулами, на кол-во строк последнего заполненного столбца?
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37659063
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Сорри не проверил кодироку
КОД
Код: vbnet
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.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
Attribute VB_Name = "Module3"
Sub Макрос3()
Attribute Макрос3.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Макрос3 Макрос
'
    Application.ScreenUpdating = False
'Фильтр на несоответствие
    ActiveSheet.Range("$A$1:$F$2098").AutoFilter Field:=1, Criteria1:="=41**", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$F$2098").AutoFilter Field:=2, Criteria1:="<>"
    Columns("A:F").Select
    Range("A170").Activate
    Selection.Copy
'Вставляем в лист2
    Sheets("Лист2").Select
    Range("A1").Select
    ActiveSheet.Paste
'Подтягиваем значения из справочника
    Range("E1:E1301").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Справочник!R1C1:R22C2,2)"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E1301"), Type:=xlFillDefault
    Range("E2:E1301").Select
'Копируем и вставляем значения
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
'вставляем промежуточные итоги
    'Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6), _
    'Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
' Прочие
'
    Sheets.Add
    ActiveSheet.Name = "Прочие"
    Range("A1").Select
    Sheets("Лист2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=005", Operator:=xlOr, Criteria2:= _
        "=009"
    Selection.Copy
    Sheets("Прочие").Select
    ActiveSheet.Paste
'Вставляем формулы
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
    Selection.NumberFormat = "General"

    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Selection.NumberFormat = "0.00%"
    
    Range("H2:I2").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("H2:I750"), Type:=xlFillDefault
    Range("H2:I750").Select

' Бюджет
'
    Sheets.Add
    ActiveSheet.Name = "Бюджет"
    Range("A1").Select
    Sheets("Лист2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=010"
    Selection.Copy
    Sheets("Бюджет").Select
    ActiveSheet.Paste
    
' Сельхоз
'
    Sheets.Add
    ActiveSheet.Name = "Сельхоз"
    Range("A1").Select
    Sheets("Лист2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=011"
    Selection.Copy
    Sheets("Сельхоз").Select
    ActiveSheet.Paste
    
    
' Население
'
    Sheets.Add
    ActiveSheet.Name = "Население"
    Range("A1").Select
    Sheets("Лист2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:=Array( _
        "012", "013", "014", "015", "016", "017"), Operator:=xlFilterValues
    Selection.Copy
    Sheets("Население").Select
    ActiveSheet.Paste
        
        
    Application.ScreenUpdating = True
End Sub

...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37659139
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
balbes,

Вот такие конструкции
Код: vbnet
1.
2.
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Справочник!R1C1:R22C2,2)"


меняются на
Код: vbnet
1.
    Range("E2").FormulaR1C1 = "=VLOOKUP(RC[-1],Справочник!R1C1:R22C2,2)"


код становится гораздо читабельней и можно давать советы дальше

Копировать через буфер обмена тоже необязательно, можно присваивать напрямую
Код: vbnet
1.
Range("E2")=Range("E3")


вот такие
Код: vbnet
1.
2.
3.
4.
5.
    Range("A1").Select
    Sheets("Лист2").Select
    Columns("A:G").Select
    Range("G1").Activate
    Selection.AutoFilter

конструкции вообще бессмысленны, можно
Код: vbnet
1.
    Sheets("Лист2").Range("G1").AutoFilter


причешите, посмотрим дальше
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37660031
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
GE Shocker.Pro огромное спасибо. Фсе оказалось проще :) Вы мне открыли глаза... Вот результат
КОД
Код: vbnet
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.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
Attribute VB_Name = "Module3"
Sub Макрос3()
Attribute Макрос3.VB_ProcData.VB_Invoke_Func = " \n14"
'
' Макрос3 Макрос
'
    Application.ScreenUpdating = False
'Фильтр на несоответствие
    ActiveSheet.Range("$A$1:$F$2098").AutoFilter Field:=1, Criteria1:="=41**", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$F$2098").AutoFilter Field:=2, Criteria1:="<>"
    Columns("A:F").Select
    Range("A170").Activate
    Selection.Copy
'Вставляем в лист2
    Sheets("Лист2").Paste
'Подтягиваем значения из справочника
    Sheets("Лист2").Activate
    Range("E1:E1301").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E2:E1301").FormulaR1C1 = "=VLOOKUP(RC[-1],Справочник!R1C1:R22C2,2)"
    
'вставляем промежуточные итоги
    'Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6), _
    'Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
' Прочие
'
    Sheets.Add.Name = "Прочие"
    Sheets("Лист2").Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=005", Operator:=xlOr, Criteria2:= _
        "=009"
    Sheets("Лист2").Range("$A$1:$G$1301").Copy
    Sheets("Прочие").Paste
     
'Вставляем формулы
    Sheets("Прочие").Range("H2:H750").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Sheets("Прочие").Range("H2:H750").NumberFormat = "General"

    Sheets("Прочие").Range("I2:I750").FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets("Прочие").Range("I2:I750").NumberFormat = "0.00%"
    

' Бюджет
'
    Sheets.Add.Name = "Бюджет"
    Sheets("Лист2").Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=010"
    Sheets("Лист2").Range("$A$1:$G$1301").Copy
    Sheets("Бюджет").Paste
     
'Вставляем формулы
    Sheets("Бюджет").Range("H2:H750").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Sheets("Бюджет").Range("H2:H750").NumberFormat = "General"

    Sheets("Бюджет").Range("I2:I750").FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets("Бюджет").Range("I2:I750").NumberFormat = "0.00%"
    
' Сельхоз
'
    Sheets.Add.Name = "Сельхоз"
    Sheets("Лист2").Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:= _
        "=011"
    Sheets("Лист2").Range("$A$1:$G$1301").Copy
    Sheets("Сельхоз").Paste
     
'Вставляем формулы
    Sheets("Сельхоз").Range("H2:H750").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Sheets("Сельхоз").Range("H2:H750").NumberFormat = "General"

    Sheets("Сельхоз").Range("I2:I750").FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets("Сельхоз").Range("I2:I750").NumberFormat = "0.00%"
    
' Население
'
    Sheets.Add.Name = "Население"
    Sheets("Лист2").Range("$A$1:$G$1301").AutoFilter Field:=4, Criteria1:=Array( _
        "012", "013", "014", "015", "016", "017"), Operator:=xlFilterValues
        
    Sheets("Лист2").Range("$A$1:$G$1301").Copy
    Sheets("Население").Paste
     
'Вставляем формулы
    Sheets("Население").Range("H2:H750").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Sheets("Население").Range("H2:H750").NumberFormat = "General"

    Sheets("Население").Range("I2:I750").FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets("Население").Range("I2:I750").NumberFormat = "0.00%"

        
    Application.ScreenUpdating = True
End Sub

Хотел бы поинтересоваться как программно узнать (вычислить) количество строк во вставляемом диапазоне? Что бы уйти от фиксированных Range("I2:I750")...
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37660045
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
balbesколичество строк во вставляемом диапазоне?имеется ввиду, видимо - как найти конец использованного диапазона? Например этот код
Код: vbnet
1.
Range("A1").End(xlDown).Row

вернет номер последней использованной строки в столбце А (при условии, правда, что там нет пустых ячеек)

balbesогромное спасибо. Фсе оказалось прощесоветую вообще забыть слово Select и убрать его из кода
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37660333
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hi Shocker.Pro от буфера уйти не удается... работает только следующим образом...

Код: vbnet
1.
2.
Sheets("Лист2").Range("$A$1:$G$1301").Copy
Sheets("Прочие").Paste



ни так...
Код: vbnet
1.
Sheets("Прочие")=Sheets("Лист2")


не так не работает...
Код: vbnet
1.
Sheets("Прочие").Range("$A$1:$G$1301")=Sheets("Лист2").Range("$A$1:$G$1301")
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37660380
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
balbesне так не работаетвот так:
Код: vbnet
1.
Sheets("Лист1").Range("$A$1:$G$1301").Value = Sheets("Лист2").Range("$A$1:$G$1301").Value
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37661211
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот так:
Код: vbnet
1.
Sheets("Лист2").Range("$A$1:$G$1301").Copy Sheets("Прочие").Range("$A$1")
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37661820
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
GE Shocker.Pro & AndreTM
огромное спб. что помогаете! Сделал так
Код: vbnet
1.
Sheets("Лист1").Range("A1").CurrentRegion.Copy Sheets("Лист2").Range("A1")

диапазон цельный без разрывов (извиняюсь за двусмысленные термины), копируется замечательно...
не могу победить вставку формулы...
Код: vbnet
1.
2.
3.
Sheets("Лист2").Activate
Sheets("Лист2").Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Лист2").Range("E1", Range("E1").End(xlDown)).FormulaR1C1 = "=VLOOKUP(RC[-1],Справочник!R1C1:R22C2,2)"

Столбик добавляет а вот формулу в столбик E по последнюю строку (вставленного диапазона) вставить не могу... хотя вроде именно Range("E1", Range("E1").End(xlDown)) это нашел по описанию должно работать, на деле формула вставляется до конца листа т.е. E1:E65000, гораздо больше чем вставленный диапазон. пробовал Range("E1").End(xlDown).Row - ругается на транскрипцию...
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37661891
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Так ведь столбец E пустой, вот он и вставляет до конца
Смысл End(xlDown) в том, чтобы как раз найти конец данных, а данных нет
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37661895
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
balbes
Код: vbnet
1.
Sheets("Лист2").Activate

зы... ну и эта команда бессмысленна
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37661972
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
OK спб. Shocker.Pro Sheets.Activate - выкинул как ни странно работает... и нарыл как найти кол-во строк в диапазоне с твоей подачи...

подскажи как процедуру или функцию оформить? и как вызвать... Вот этот код надо запихать на 4 листа...
Прочие, Бюджет, Сельхоз, Население - соответственно...

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
'Вставляем формулы
    lastRow = Sheets("Прочие").Cells.End(xlDown).Row
    Sheets("Прочие").Range("H2:H" & lastRow).FormulaR1C1 = "=RC[-2]-RC[-1]"
    Sheets("Прочие").RRange("H2:H" & lastRow).NumberFormat = "General"

    Sheets("Прочие").Range("I2:I" & lastRow).FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets("Прочие").Range("I2:I" & lastRow).NumberFormat = "0.00%"
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37661983
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
sub MyInsFormulas (cShName as String)
    Dim lastRow
    lastRow = Sheets(cShName).Cells.End(xlDown).Row
    Sheets(cShName).Range("H2:H" & lastRow).FormulaR1C1 = "=RC[-2]-RC[-1]"
    Sheets(cShName).RRange("H2:H" & lastRow).NumberFormat = "General"

    Sheets(cShName).Range("I2:I" & lastRow).FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets(cShName).Range("I2:I" & lastRow).NumberFormat = "0.00%"
end sub


Вызов (как-то так):
Код: vbnet
1.
2.
MyInsFormulas "Прочие"
MyInsFormulas "Бюджет"
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37662303
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hi AndreTM , низкий поклон
я так понимаю это процедура?... Фсе еще проще чем я думал... даже объявлять никак не нужно О_о
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37662870
Фотография ПЕНСИОНЕРКА
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
balbes,

отчет в НТМ-формате
код надо подправить --вечером видимо

почему у вас контрагент иероглифами, хотя договор --нормально
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37664057
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Добрый вечер Мадам ПЕНСИОНЕРКА ! Балуете Вы меня...
огромное спб. не терпится увидеть код... Теперь ночь спать не буду...
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37664099
Фотография ПЕНСИОНЕРКА
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
посмотрите пока как есть(некогда править)
-модуль2
-запускается с листа4

кое-что лишнее и выборки нет
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37666505
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hi Мадам ПЕНСИОНЕРКА оч. интересная работа.

но HTML поддержки руководства не получил, к сожалению!..
Хотят отчет видеть в xls, для дальнейшего анализа.

а по функциям xls не подскажите?

Хочу своять функцию возвращающую диапазон для вставки или адреса ячеек (верх низ) диапазона, что бы применительно к нему осуществить вставку формул...
Может ли функция вернуть 2 параметра? или сразу диапазон?
Что-то на подобии
Код: vbnet
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.
Sub 

Dim N,InsRange

    N="Прочие"
    InsRange=FInsRange(N) 
    Sheets(N).Range(InsRange).FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets(N).Range(InsRange).NumberFormat = "0.00%"
    
End Sub

Function FInsRange(NmSh As String) As String

Dim ClUp, ClDw
Dim LastRow, LastCol
    
    LastRow = Sheets(NmSh).UsedRange.Row + Sheets(NmSh).UsedRange.Rows.Count - 1
    LastCol = Sheets(NmSh).UsedRange.Column + Sheets(NmSh).UsedRange.Columns.Count - 1

    ClUp = Cells(5, LastCol + 1).Address
    ClDw = Cells(LastRow, LastCol + 1).Address
    
    FInsRange = Range(ClUp, ClDw)

End Function


Или если как то можно по другому проще без собственных функций вычислить вставляемые диапазоны, подскажите плз...
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37666527
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
Function MyRange(nTop As Long, nLeft As Long, nBottom As Long, nRight As Long) As Range
    Set MyRange = Range(Cells(nTop, nLeft), Cells(nBottom, nRight))
End Function
' ...
Sub test()
    MsgBox MyRange(2, 3, 5, 6).Rows.Count
End Sub
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37666536
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hi AndreTM
изящно и оперативно
огромное спб.
...
Рейтинг: 0 / 0
Обработка данных xls для создания отчета в xls
    #37668756
balbes
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
hi ALL

помогите с объявлением переменных...
Кусками обкатал все работало... А когда скидал значения в переменные не стали подтягиваться...
Код
Код: vbnet
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.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
Attribute VB_Name = "Module3"
Public LastCell, LastRow, NmPvTb, NmSh As String
Public Sub Макрос3()
'
' Макрос3 Макрос
'

    Application.ScreenUpdating = False
'Фильтр на несоответствие
    Sheets("Лист1").Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:="=41**", _
        Operator:=xlAnd
    Sheets("Лист1").Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:="<>"

'Вставляем в лист2
    Sheets("Лист1").Range("A1").CurrentRegion.Copy Sheets("Лист2").Range("A1")
'Подтягиваем значения из справочника
    LastRow = Sheets("Лист2").Cells.End(xlDown).Row
    Sheets("Лист2").Columns("E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Лист2").Range("E1:E" & LastRow).FormulaR1C1 = "=VLOOKUP(RC[-1],Справочник!R1C1:R22C2,2)"
    
    
'Вставляем шапку (Переименуем колонки)
    Sheets("Лист2").Range("A1").Value = "Конт. счет"
    Sheets("Лист2").Range("B1").Value = "Потребитель"
    Sheets("Лист2").Range("C1").Value = "№ дата, дог."
    Sheets("Лист2").Range("D1").Value = "№ уст-ки"
    Sheets("Лист2").Range("E1").Value = "Вид установки"
    Sheets("Лист2").Range("F1").Value = "ФАКТ"
    Sheets("Лист2").Range("G1").Value = "ПЛАН"
'    Sheets("Лист2").Range("H1").Value = "отк. кВтч"
'    Sheets("Лист2").Range("I1").Value = "отк. %"
    
    
'Вояем сводную таблицу
    CrPvTab ("Сводная")
'Фильтруем Сводную таблицу по категориям и формируем вкладки
' Прочие
'
    ClearFl ("Прочие*")
    CrSheet ("Прочие")
' Бюджет
'
    ClearFl ("Бюджетные*")
    CrSheet ("Бюджет")
' Сельхоз
'
    ClearFl ("Сельскохоз*")
    CrSheet ("Сельхоз")
' Население
'
    ClearFl ("*насел*")
    CrSheet ("Население")
' Компенсация
'
    ClearFl ("Компенсация*")
    CrSheet ("Компенсация")

Application.ScreenUpdating = True

End Sub
Sub ClearFl(Flt As String)

    With Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields("Вид установки")
'    With Sheets("Сводная").PivotTables("Сводная").PivotFields("Вид установки")
        For i = 1 To .PivotItems.Count
            If .PivotItems(i).Name Like Flt Then
                .PivotItems(i).Visible = True
            Else
                .PivotItems(i).Visible = False
            End If
        Next i
    End With
End Sub
Sub CrSheet(NmSh As String)
'Копируем сводную таблицу
    lLastRow = Sheets(NmPvTb).UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    lLastCol = Sheets(NmPvTb).UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
    
    Sheets(NmPvTb).Range("a4:" & _
        Cells(lLastRow, lLastCol).Address).Copy
    Sheets.Add.Name = NmSh
    Sheets(NmSh).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Вставляем формЫлы
    FmlAdd (NmSh)
'Вставляем шапку
    RenTab (NmSh)
End Sub
Sub FmlAdd(NmSh As String)
'Вставляем формулы кВтч
    MyRg = LsClRg(NmSh).Address
    Sheets(NmSh).Range(MyRg).FormulaR1C1 = "=RC[-2]-RC[-1]"
    Sheets(NmSh).Range(MyRg).NumberFormat = "General"
'Вставляем формулы %
    MyRg = LsClRg(NmSh).Address
    Sheets(NmSh).Range(MyRg).FormulaR1C1 = "=IF(RC[-3]=0,0,RC[-3]/RC[-2])-1"
    Sheets(NmSh).Range(MyRg).NumberFormat = "0.00%"
End Sub
Function LsClRg(NmSh As String) As Range
'Адрес последнего столбца +1
Dim ClUp, ClDw
Dim LastRow, LastCol

    LastRow = Sheets(NmSh).UsedRange.Row + Sheets(NmSh).UsedRange.Rows.Count - 1
    LastCol = Sheets(NmSh).UsedRange.Column + Sheets(NmSh).UsedRange.Columns.Count - 1
    ClUp = Cells(2, LastCol + 1).Address
    ClDw = Cells(LastRow, LastCol + 1).Address

    Set LsClRg = Range(ClUp, ClDw)
End Function

Sub RenTab(NmTb As String)
'Вставляем шапку (Переименуем колонки)
    Sheets(NmTb).Range("A1").Value = "Потребитель"
    Sheets(NmTb).Range("B1").Value = "№ дата, дог."
    Sheets(NmTb).Range("C1").Value = "№ уст-ки"
    Sheets(NmTb).Range("D1").Value = "Вид установки"
    Sheets(NmTb).Range("E1").Value = "ФАКТ"
    Sheets(NmTb).Range("F1").Value = "ПЛАН"
    Sheets(NmTb).Range("G1").Value = "отк. кВтч"
    Sheets(NmTb).Range("H1").Value = "отк. %"
End Sub
Public Sub CrPvTab(NmPvTb As String)
'
' формируем сводную таблицу
'
    Sheets.Add.Name = NmPvTb
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Лист2!R1C1:R65536C7", Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:=NmPvTb & "!R3C1", TableName:=NmPvTb, _
        DefaultVersion:=xlPivotTableVersion10
    With Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields("Вид установки")
        .Orientation = xlPageField
        .Position = 1
    End With
    With Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields("Потребитель")
        .Orientation = xlRowField
        .Position = 1
    End With
    With Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields("№ дата, дог.")
        .Orientation = xlRowField
        .Position = 2
    End With

    Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields("Потребитель"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)

    Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields("№ дата, дог."). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)

    Sheets(NmPvTb).PivotTables(NmPvTb).AddDataField Sheets(NmPvTb).PivotTables _
        (NmPvTb).PivotFields("ФАКТ"), "Количество по полю ФАКТ", xlCount
    Sheets(NmPvTb).PivotTables(NmPvTb).AddDataField Sheets(NmPvTb).PivotTables _
        (NmPvTb).PivotFields("ПЛАН"), "Количество по полю ПЛАН", xlCount
    With Sheets(NmPvTb).PivotTables(NmPvTb).DataPivotField
        .Orientation = xlColumnField
        .Position = 1
    End With

    With Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields( _
        "Количество по полю ФАКТ")
        .Caption = "Сумма по полю ФАКТ"
        .Function = xlSum
    End With

    With Sheets(NmPvTb).PivotTables(NmPvTb).PivotFields( _
        "Количество по полю ПЛАН")
        .Caption = "Сумма по полю ПЛАН"
        .Function = xlSum
    End With
            
End Sub

За одно может и код причешете, жду советов по оптимизации...
...
Рейтинг: 0 / 0
25 сообщений из 30, страница 1 из 2
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Обработка данных xls для создания отчета в xls
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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