Страницы: 1
RSS
Макрос выдвет ошибку.
 
Уважаемые форумчане, пишу макрос - должен в выбранном диапазоне в зависимоти от месяца копировать и вставлять данные значениями. - голову уже сломал - посмотрите пожалуйста код:  
Sub qwert()  
   Dim wb As Workbook  
   Dim WBfrom As Workbook  
   Dim SHname As String  
   Dim MonthNum As Integer  
   Dim r As Integer  
       Set wb = ThisWorkbook  
   With wb.Sheets("Прогноз")  
       MonthNum = WorksheetFunction.VLookup(.Range("A2"), .Range("AC3:AD14"), 2, 0) 'по названию месяца подтягиваем его номер с помощью ВПР  
   End With  
   With wb.Sheets("Прогноз")  
       For r = 98 To .Cells(.Rows.Count, 4).End(xlUp).Row 'для всех строк с 98 по последнию в 4 столбце листа Прогноз  
           'в столбце, определяемым номером месяца, копируем диапазон:  
           .Cells(r, 4 + MonthNum) = WorksheetFunction.Copy(r, 4)(Вроде ошибка тут...)  
           .Paste(r, 4 + MonthNum) = WorksheetFunction.Paste(r, 4)  
          Next r  
   End With  
   End Sub
 
Добрый день  
 
Вот этот кусок - полный бред  
.Cells(r, 4 + MonthNum) = WorksheetFunction.Copy(r, 4)(Вроде ошибка тут...)  
.Paste(r, 4 + MonthNum) = WorksheetFunction.Paste(r, 4)
 
Язык программирования VBA имеет свой синтаксис.  
Почему вы его не соблюдаете?  
 
Что это за загадочные конструкции?  
.Cells(r, 4 + MonthNum) = WorksheetFunction.Copy(r, 4)  
.Paste(r, 4 + MonthNum) = WorksheetFunction.Paste(r, 4)  
 
 
Так и не понял, что должно происходить внутри цикла For r = 98 To .Cells(.Rows.Count, 4).End(xlUp).Row...  
 
 
Если надо просто заменить формулы значениями - то всё делается проще:  
 
 
   Dim ra As Range  
   With wb.Sheets("Прогноз")  
       Set ra = .Range(.Cells(98, 4 + MonthNum), .Cells(.Rows.Count, 4).End(xlUp))  
       ra.Value = ra.Value    ' заменяем формулы значениями сразу во всем диапазоне  
   End With
 
Спасибо, а какой связкой необходимо скреплять 2 макроса в 1?
 
Sub qwert()  
Call mak1  
Call mak2  
Call mak152  
End Sub
 
Vikttur - куда вставить, то? если у меня макрос №1:  
Sub ternovsky(strWbName As String)  
   Dim wbData As Workbook, strShtData As String, strMohth As String, shtDate _  
   As Worksheet, li As Long, strText As String, rTextFind As Range, _  
   vFirstAddress As Variant, rMonthFind As Range, rClearning As Range, lLastRow As Long  
   Unload UserForm1  
   Application.ScreenUpdating = False  
   Sheets("Факт").Visible = True 'моя правка  
   Sheets("Прогноз").Visible = True 'моя правка  
   Sheets("Факт").Select  
   Application.ScreenUpdating = True  
'   Задать имя листа  
   strShtData = Format("01." & Cells(2, 1).Value & "." & Format(Now, "yy"), "mm.yy")  
   Set wbData = Workbooks(strWbName): Set shtDate = wbData.Sheets(strShtData)  
'   Если лист не существует и ячейка с названием месяца пуста - выход  
   If Not WorksheetIsExist(shtDate.Name) And Cells(2, 1).Text = "" Then Exit Sub  
   strShtData = Format("01." & Cells(2, 1).Value & "." & Format(Now, "yy"), "m")  
   Set rMonthFind = Range(Cells(97, 4), Cells(97, 15)).Find(strShtData, LookIn:=xlValues, LookAt:=xlWhole)  
   Application.ScreenUpdating = False  
   Application.Calculation = xlCalculationManual  'отключение пересчёт формул вручную  
   Sheets("Факт").Select 'моя правка  
'   Определить последнею заполненную ячейку в заполняемом диапазоне  
   lLastRow = Cells(Rows.Count, rMonthFind.Column).End(xlUp).Row  
   lLastRow = IIf(lLastRow > 98, lLastRow, 98)  
'   Очистить заполняемый диапазон  
   Set rClearning = Range(Cells(98, rMonthFind.Column), Cells(lLastRow, rMonthFind.Column))  
   If Not rClearning Is Nothing Then rClearning.ClearContents  
'   Перебор всех ячеек на листе "Свод"  
   For li = 98 To Cells(Rows.Count, 3).End(xlUp).Row  
       strText = Cells(li, 3)  
'       Добавление значение по заданному критерию  
       With shtDate.Range(shtDate.Cells(11, 14), shtDate.Cells(shtDate.Rows.Count, 14).End(xlUp))  
           Set rTextFind = .Find(strText, LookIn:=xlValues, LookAt:=xlWhole)  
           If Not rTextFind Is Nothing Then  
               vFirstAddress = rTextFind.Address  
               Do  
                   If rTextFind.Value = strText Then  
                       Cells(li, rMonthFind.Column).Value = Cells(li, _  
                           rMonthFind.Column).Value + rTextFind.Offset(0, -9).Value  
                       Set rTextFind = .FindNext(rTextFind)  
                   End If  
               Loop While Not rTextFind Is Nothing And rTextFind.Address <> vFirstAddress  
           End If  
       End With  
   Next li  
   Sheets("Факт").Visible = False  
   Sheets("Главная").Select  
   Application.ScreenUpdating = True  
   Application.Calculation = xlCalculationAutomatic  
   Set shtDate = Nothing: Set wbData = Nothing  
   End Sub  
А макрос №2    
Sub qwert()  
   Dim wb As Workbook  
   Dim WBfrom As Workbook  
   Dim SHname As String  
   Dim MonthNum As Integer  
   Dim r As Integer  
       Set wb = ThisWorkbook  
   With wb.Sheets("Прогноз")  
       MonthNum = WorksheetFunction.VLookup(.Range("A2"), .Range("AC3:AD14"), 2, 0) 'по названию месяца подтягиваем его номер с помощью ВПР  
   End With  
       Dim ra As Range  
       With wb.Sheets("Прогноз")  
       Set ra = .Range(.Cells(98, 4 + MonthNum), .Cells(.Rows.Count, 4).End(xlUp))  
       ra.Value = ra.Value ' заменяем формулы значениями сразу во всем диапазоне  
   End With  
   End Sub  
 
- как их соединить этой связкой, подскажи пожалуйста.
 
Да что тут соединять :)  
 
Вместо этой части кода:  
---------------------------------  
With wb.Sheets("Прогноз")  
For r = 98 To .Cells(.Rows.Count, 4).End(xlUp).Row 'для всех строк с 98 по последнию в 4 столбце листа Прогноз  
'в столбце, определяемым номером месяца, копируем диапазон:  
.Cells(r, 4 + MonthNum) = WorksheetFunction.Copy(r, 4)(Вроде ошибка тут...)  
.Paste(r, 4 + MonthNum) = WorksheetFunction.Paste(r, 4)  
Next r  
End With  
---------------------------------  
 
вставьте часть Игоря (EducatedFool)  
---------------------------------  
Dim ra As Range  
With wb.Sheets("Прогноз")  
Set ra = .Range(.Cells(98, 4 + MonthNum), .Cells(.Rows.Count, 4).End(xlUp))  
ra.Value = ra.Value ' заменяем формулы значениями сразу во всем диапазоне  
End With  
---------------------------------
<FONT COLOR="CadetBlue">
 
В одном макросе просите Excel пройтись по двум макросам :)  
Sub ja_vam_pokajy_gde_raki_zimujyt()  
Call ternovsky  
Call qwert  
End Sub
 
Виктор, зачем человека так сразу учить нехорошему? ;)
<FONT COLOR="CadetBlue">
 
Действительно, что это я? Формулы/функции показывать надо...    
Уже покраснел и спрятался :)
 
Не нужно прятаться ;)  
 
Где-то кто-то когда-то написал подобные слова: "Не нужно читать только первичное высказывание автора, нужно читать все его высказывания".  
 
P.S. Как-то так :)
<FONT COLOR="CadetBlue">
 
> какой связкой необходимо скреплять 2 макроса в 1?  
 
В конце ( или в начале) одного макроса вызвать другой:  
 
Sub ternovsky(strWbName As String)  
'...  
qwert  
End Sub  
 
Sub qwert  
'...  
End Sub
 
Алексей, может я что-то не понимаю, но зачем в данном случае делать 2-а макроса, если здесь нужно заменить? :)
<FONT COLOR="CadetBlue">
 
Дмитрий, в данном случае не надо. Я ответил на общий вопрос "какой связкой необходимо скреплять 2 макроса в 1?", предложив вариант, отличающийся от варианта Виктора.
 
Dim r As Integer  
       Set wb = ThisWorkbook  
   With wb.Sheets("Прогноз")  
       MonthNum = WorksheetFunction.VLookup(.Range("A2"), .Range("AC3:AD14"), 2, 0) 'по названию месяца подтягиваем его номер с помощью ВПР  
   End With  
       Dim ra As Range  
       With wb.Sheets("Прогноз")  
       Set ra = .Range(.Cells(98, 4 + MonthNum), .Cells(.Rows.Count, 4).End(xlUp))  
       ra.Value = ra.Value ' заменяем формулы значениями сразу во всем диапазоне  
 
- Макрос рабатает как - находит строку 98 + откладывает порядковый номер месяца - получается столбец - далее он копирует диапазон с первого столбца отчета по выбранный. Тоесть если выбрать Декабрь, то он удьет формулы во всех предыдущих столбцах.  
- как переделать его чтоб он копировал только значения столбца выбранного месяца?
Страницы: 1
Читают тему
Наверх
Loading...