Доброго дня!
Может кто-то знает, почему при отладке через F8 макрос срабатывает, а через F5 нет.
Даже проверить не могу в чем ошибка, ведь по шагам все работает.
Могу приложить сам макрос, но, увы, без исходника (политика безопасности)
Выдает ошибку “В файле Global INT CSAT отcутствуют или переименованы листы Russia или Meta. Проверьте исходные данные. Макрос будет завершен»
При этом корень зла, судя по результатам лежит раньше. В ходе перебора одного из листов, результаты одного (META) не выводятся (по шагам они выводятся).
И далее код начиная с коммента “Преобразование полных названий файлов в названия регионов” уже не выполняется. Опять-таки, судя по результатам, которые я вижу после выполнения.
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.
Sub B2C_Global()
SelectedFile = Application.GetOpenFilename _
("Excel files(*.xls*),*.xls*", 1, "Выберите CSAT INT GLOBAL за текущий месяц", , False)
If VarType(SelectedFile) = vbBoolean Then
Exit Sub
End If
Workbooks.Open SelectedFile
Workbooks.OpenText Filename:=SelectedFile
Set wb = ActiveWorkbook
CurMonth = Mid(wb.Name, 17, (InStr(1, wb.Name, " 20") - 17))
CurMonth = "*" & CurMonth & "*"
wb.Activate
i = 2
For Each ws In Worksheets
ws.Activate
'Обрабатываем только листы B2C
If Not ws.Name Like "*B2C*" Then
GoTo 1:
End If
Set pvt = ws.PivotTables(1)
Set rng = pvt.TableRange1
ThisWorkbook.Worksheets("B2C").Cells(i, 1).Value = ws.Name
On Error Resume Next
'Если текущий месяц в сводной отсутствует, макрос завершаем
If IsError(Application.WorksheetFunction.VLookup(CurMonth, rng, 7, 0)) Then
MsgBox "На листе " & ws.Name & " в сводной таблице " & pvt.Name & " отсутствует " & CurMonth & ". Макрос будет завершён."
Exit Sub
End If
'Вытаскиваем значение из сводной, находящееся напротив текущего месяца в 7м столбце
ThisWorkbook.Worksheets("B2C").Cells(i, 2).Value = Application.WorksheetFunction.VLookup(CurMonth, rng, 7, 0)
i = i + 1
1:
Next ws
NUMB2CGlobal = i - 2
MsgBox NUMB2CGlobal
'Преобразование полных названий листов в названия регионов
ThisWorkbook.Worksheets("B2C").Range(Cells(2, 3), Cells(NUMB2CGlobal + 1, 3)).FormulaR1C1 = "=UPPER(LEFT(RC[-2],FIND(""B2C"",RC[-2],1)-2))"
ThisWorkbook.Worksheets("B2C").Range(Cells(2, 3), Cells(NUMB2CGlobal + 1, 3)).Copy
ThisWorkbook.Worksheets("B2C").Range(Cells(2, 1), Cells(NUMB2CGlobal + 1, 1)).PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Worksheets("B2C").Range(Cells(2, 3), Cells(NUMB2CGlobal + 1, 3)).Clear
'Сложение Russia + Meta
Flag = 0
n = NUMB2CGlobal + 1
For i = n To 2 Step -1
If ThisWorkbook.Worksheets("B2C").Cells(i, 1).Value Like "*RUSSIA*" Or ThisWorkbook.Worksheets("B2C").Cells(i, 1).Value Like "*META*" Then
SUMrm = SUMrm + ThisWorkbook.Worksheets("B2C").Cells(i, 2).Value
Flag = Flag + 1
ThisWorkbook.Worksheets("B2C").Rows(i).Delete
End If
Next i
If Flag = 2 Then
ThisWorkbook.Worksheets("B2C").Cells(n - 1, 1).Value = "RUSSIA + META"
ThisWorkbook.Worksheets("B2C").Cells(n - 1, 2).Value = SUMrm
Else
MsgBox "В файле Global INT CSAT отcутствуют или переименованы листы Russia или Meta. Проверьте исходные данные. Макрос будет завершен."
End If
wb.Close
End Sub
Буду премного благодарна за совет.
Спасибо.
