Здравствуйте, уважаемые специалисты. Я столкнулся с проблемой, которая, вероятно, покажется вам глупой, но, тем не менее, я исчерпал все свои собственные возможности для её решения. Возможно, вы сможете или указать на ошибку, или, хотя бы, направить в нужную сторону для поиска решения. За любую помощь заранее благодарен.
Итак, процедура делает следующее:
Итак, процедура делает следующее:
- Пользователь выбирает книги Excel (GetOpenFilename) для обработки.
- Данные в книгах обрабатываются и переносятся в другую книгу, тоже выбранную с помощью GetOpenFilename.
- Проблема в том, что в начале процедуры код "WbToInsert.Worksheets("IQVIA").Select" выполняется корректно, а в конце той же самой процедуры тот же код выдаёт ошибку: "Метод Select из класса Worksheet завершён неверно".
- WbToInsert - объектная переменная, действующая во всём модуле (Private, объявлена в шапке модуля и назначена в одной из процедур модуля).
- Книга не закрывалась, листы не удалялись и не переименовывались. Листы имеют свойство "visible".
- Ниже я приведу код процедуры, как есть.
Код |
---|
Sub InsertDatasSubreg() '6. Вставляем данные из исходных книг в книгу "KPI..." по субрегионам. Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z As Long Dim lngLastRowNumberKPI As Long Dim lngStartRowNumberKPI As Long Dim lngCurentRowNumberKPI As Long Dim objBasicCellKPI As Range Dim strCellNameKPI As String Dim lngCurentBookNumberOrigin As Long Dim strWb As String Dim Wb As Workbook Dim Wsh As Worksheet Dim strWshName As String Dim strWshNameApprox As String Dim strCellNameSubregOrigin As String Dim strCellNameBrandOrigin As String Dim lngLastRowNumber As Long Dim lngStartRowNumber As Long Dim lngCurentRowNumberOrigin As Long Dim objBasicCell As Range WbToInsert.Worksheets("IQVIA").Select 'Выбираем лист в книге "KPI", куда будут вставляться данные - Работает корректно, а в самом конце процедуры то же самое, выдаёт ошибку lngLastRowNumberKPI = Cells(Rows.Count, 2).End(xlUp).Row 'Определяем номер последней строки 2-ого столбца. For a = 1 To lngLastRowNumberKPI Step 1 'Определяем номер первой строки начала диапазона - сразу под Субрегион. Set objBasicCellKPI = ActiveSheet.Cells(a, 2) Select Case objBasicCellKPI Case Is = "IQVIA" b = a Exit For End Select Next a lngStartRowNumberKPI = b + 1 'Это № строки начала диапазона. 'Очищаем содержимое диапазона ранее вставленных данных Range("C" & lngStartRowNumberKPI & ":" & "AZ" & lngLastRowNumberKPI).Select Selection.ClearContents For lngCurentRowNumberKPI = lngStartRowNumberKPI To lngLastRowNumberKPI Step 1 'Перебираем каждую строку листа "IQVIA", диапазона для вставки. strCellNameKPI = WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 2).Value 'Содержимое ячейки ' Debug.Print "lngCurentRowNumberKPI= " & lngCurentRowNumberKPI ' Debug.Print "strCellNameKPI= " & strCellNameKPI For lngCurentBookNumberOrigin = LBound(varFilesToOpen) To UBound(varFilesToOpen) Step 1 strWb = Dir(varFilesToOpen(lngCurentBookNumberOrigin)) Set Wb = Workbooks(strWb) 'Назначаем объектную переменную, ссылающуюся на исходную книгу с данными по субрегионам. Wb.Activate For Each Wsh In Wb.Worksheets 'Перебираем каждый лист исходной книги по субрегионам. Wsh.Activate strWshName = Wsh.Name 'Имя текущего листа strWshNameApprox = UCase("*" & strWshName & "*") 'Приблизительное имя текущего листа ' Debug.Print "strWshName= " & strWshName lngLastRowNumber = Cells(Rows.Count, 1).End(xlUp).Row 'Определяем номер последней строки первого столбца. Это № строки конца диапазона копирования исходной книги. For d = 1 To lngLastRowNumber Step 1 'Определяем номер первой строки начала диапазона копирования - сразу под IQVIA. Set objBasicCell = ActiveSheet.Cells(d, 1) 'Исходная книга Select Case objBasicCell Case Is = "Субрегион" e = d Exit For End Select Next d lngStartRowNumber = e + 1 'Это № строки начала диапазона копирования. For lngCurentRowNumberOrigin = lngStartRowNumber To lngLastRowNumber Step 1 'Перебираем каждую строку исходного листа. strCellNameSubregOrigin = Cells(lngCurentRowNumberOrigin, 1).Value 'Имя ячейки столбца Субрегион. strCellNameBrandOrigin = Cells(lngCurentRowNumberOrigin, 2).Value 'Имя ячейки столбца Торговые названия. Select Case strCellNameSubregOrigin 'Проверяем содержимое ячеек исходных книг. Case Is = strCellNameKPI 'Если имя ячейки исходной книги совпадает с именем ячейки KPI ' MsgBox ("Names are identical. ") & strCellNameKPI If strCellNameBrandOrigin Like strWshNameApprox Then 'Если в имени ячейки содержится имя листа ' MsgBox ("Names are identical. ") & strCellNameBrandOrigin Select Case strWshName 'Куда именно вставлять данные на лист IQVIA Case Is = "Арипризол" Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 3) 'Копируем прошлую долю рынка Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 4) 'Копируем настоящую долю рынка Case Is = "Сервитель" Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 7) 'Копируем прошлую долю рынка Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 8) 'Копируем настоящую долю рынка Case Is = "Каликста" Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 11) 'Копируем прошлую долю рынка Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 12) 'Копируем настоящую долю рынка Case Is = "Катэна" Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 15) 'Копируем прошлую долю рынка Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 16) 'Копируем настоящую долю рынка Case Is = "Вертран" Cells(lngCurentRowNumberOrigin, 8).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 19) 'Копируем прошлую долю рынка Cells(lngCurentRowNumberOrigin, 9).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 20) 'Копируем настоящую долю рынка End Select Else End If ' Case Is = "КЛАСТЕР" 'Если имя ячейки "КЛАСТЕР", то сравни имя ячейки выше "Кластер" с именем ячейки в "KPI" Select Case Cells(lngCurentRowNumberOrigin - 1, 1).Value Case Is = strCellNameKPI Select Case strWshName 'Куда именно вставлять данные на лист IQVIA Case Is = "Арипризол" Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 5) 'Копируем объём рынка прошлого периода Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 6) 'Копируем объём рынка настоящего периода Case Is = "Сервитель" Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 9) 'Копируем объём рынка прошлого периода Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 10) 'Копируем объём рынка настоящего периода Case Is = "Каликста" Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 13) 'Копируем объём рынка прошлого периода Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 14) 'Копируем объём рынка настоящего периода Case Is = "Катэна" Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 17) 'Копируем объём рынка прошлого периода Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 18) 'Копируем объём рынка настоящего периода Case Is = "Вертран" Cells(lngCurentRowNumberOrigin, 4).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 21) 'Копируем объём рынка прошлого периода Cells(lngCurentRowNumberOrigin, 5).Copy Destination:=WbToInsert.Worksheets("IQVIA").Cells(lngCurentRowNumberKPI, 22) 'Копируем объём рынка настоящего периода End Select End Select End Select Next lngCurentRowNumberOrigin Next Wsh Next lngCurentBookNumberOrigin Next lngCurentRowNumberKPI WbToInsert.Worksheets("IQVIA").Select 'На данном этапе возникает ошибка: "Метод Select из класса Worksheet завершён неверно." 'Call InsertDatasReg End Sub |