я готов. Возможно, я слепой, но я не могу найти причину, по которой код работает правильно, только если я установил точку останова или F8. Я говорю о строке, в которой я нахожу первую пустую ячейку в диапазоне (cell.value = ""). Если он запускается автоматически, значение равно 0. Если я устанавливаю точку останова перед ним и продолжаю, он вычисляет правильно. Странные символы на русском языке.
Public Sub Prepare_OMOBUS()
Dim ReportBook As Workbook
Dim wbD As Worksheet, wbS As Worksheet, wbO As Worksheet, wbK As Worksheet
Dim cell As Range
Dim lRow As Long, i As Long, k As Long
Dim namestr As String
If UserForm11.ComboBox1.Value = "" Or UserForm11.ComboBox2.Value = "" Then
MsgBox "Íå âûáðàí ãîä/ìåñÿö", 64
Exit Sub
End If
Application.ScreenUpdating = False
UserForm11.Hide
UserForm10.Show vbModeless
UserForm10.Label1.Caption = "Ïîäãîòîâêà ÀÏ..."
UserForm10.Repaint
Set wbD = ThisWorkbook.Sheets("OMOBUS_AP_DATA")
Set wbS = ThisWorkbook.Sheets("OMOBUS_PROMO_DATA")
Set wbO = ThisWorkbook.Sheets("OMOBUS_TEMPLATE")
Set wbK = ThisWorkbook.Sheets("OMOBUS")
wbD.Range("AP_DELETE").Clear
wbS.Range("PROMO_DELETE").Clear
Range("OMOBUS_AP_QUERY").Copy Destination:=wbD.Range("A1")
Range("OMOBUS_PROMO_QUERY").Copy Destination:=wbS.Range("A1")
wbK.PivotTables("PivotTable1").ManualUpdate = True
wbK.PivotTables("PivotTable2").ManualUpdate = True
UserForm10.Label1.Caption = "Ôèëüòðàöèÿ äàííûõ..."
UserForm10.Repaint
With wbK.PivotTables("PivotTable1").PivotFields("Table2.Year")
.ClearAllFilters
.CurrentPage = UserForm11.ComboBox2.Value
End With
With wbK.PivotTables("PivotTable2").PivotFields("Table2.Year")
.ClearAllFilters
.CurrentPage = UserForm11.ComboBox2.Value
End With
With wbK.PivotTables("PivotTable1").PivotFields("Table2.MONTH")
.ClearAllFilters
.CurrentPage = UserForm11.ComboBox1.Value
End With
With wbK.PivotTables("PivotTable2").PivotFields("Table2.MONTH")
.ClearAllFilters
.CurrentPage = UserForm11.ComboBox1.Value
End With
With wbK.PivotTables("PivotTable1").PivotFields("Table2.ÄÌÏ44")
.ClearAllFilters
.PivotFilters. _
Add2 Type:=xlCaptionDoesNotEqual, Value1:="0"
End With
With wbK.PivotTables("PivotTable2").PivotFields("Table2.Final Discount")
.ClearAllFilters
.PivotFilters. _
Add2 Type:=xlCaptionDoesNotEqual, Value1:="0"
End With
wbK.PivotTables("PivotTable2").RefreshTable
UserForm10.Label1.Caption = "Çàïîëíåíèå ôîðìû..."
UserForm10.Repaint
Call UnProtect1
wbO.Visible = True
wbD.Visible = True
wbS.Visible = True
wbK.Visible = True
For Each cell In wbK.Range("A7:A1000000")
If cell.Value = "" Then
i = cell.Row
Exit For
End If
Next cell
For Each cell In wbK.Range("Y7:Y1000000")
If cell.Value = "" Then
k = cell.Row
Exit For
End If
Next cell
wbK.Range(wbK.Cells(7, 1), wbK.Cells(i, 16)).Copy
wbO.Range("A3").PasteSpecial xlPasteValues
lRow = wbO.Range("A3", wbO.Range("A3").End(xlDown)).Rows.Count + 3
If lRow > 1000000 Then lRow = 3
wbK.Range(wbK.Cells(7, 25), wbK.Cells(k, 40)).Copy
wbO.Range("A" & lRow).PasteSpecial xlPasteValues
lRow = wbO.Range("A3", wbO.Range("A3").End(xlDown)).Rows.Count + 3
If lRow > 1000000 Then lRow = 3
wbO.Range("A3:P3").Copy
wbO.Range("A3:P" & lRow).PasteSpecial xlPasteFormats
UserForm10.Label1.Caption = "Ïîäãîòîâêà ôàéëà..."
UserForm10.Repaint
Dim MainFolder As String
Set ReportBook = Workbooks.Add
ThisWorkbook.Sheets("REFERENCES").Visible = True
wbO.Visible = True
ThisWorkbook.Sheets("REFERENCES").Copy Before:=ReportBook.Sheets(1)
wbO.Copy Before:=ReportBook.Sheets(1)
MainFolder = CreateObject("WScript.Shell").specialfolders("Desktop") & "\PromoTool\OMOBUS Reports\"
Dim fdObj As Object
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists(MainFolder) = False Then
fdObj.CreateFolder (MainFolder)
End If
namestr = "OMOBUS Report for (" & UserForm11.ComboBox2.Value & "-" & UserForm11.ComboBox1.Value & ") created on " & InternetTime
namestr = Replace(namestr, ":", "-")
UserForm10.Label1.Caption = "Ñîõðàíåíèå..."
UserForm10.Repaint
ReportBook.SaveAs MainFolder & namestr & ".xlsx"
wbD.Range("AP_DELETE").Clear
wbS.Range("PROMO_DELETE").Clear
ThisWorkbook.Activate
With wbO
.Select
.Range("A3:P3").ClearContents
.Range("O_DELETE").Clear
End With
Call ShowRoleSheet
Call Protect1
Set wbO = Nothing
Set wbD = Nothing
Set wbS = Nothing
Set wbK = Nothing
Set fdObj = Nothing
UserForm10.Hide
ReportBook.Activate
Application.ScreenUpdating = True
MsgBox "Îò÷åò óñïåøíî ñîçäàí è ñîõðàíåí â ïàïêó " & MainFolder, 64
End Sub