Пустая ячейка считается только через F8. Как заставить его работать автоматически? - PullRequest
0 голосов
/ 28 мая 2020

я готов. Возможно, я слепой, но я не могу найти причину, по которой код работает правильно, только если я установил точку останова или 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

1 Ответ

0 голосов
/ 02 июня 2020

Похоже, проблема возникла из-за вычислений, относящихся к сводной таблице, которая была результатом запроса мощности. Я заменил диапазоны копирования на PivotTable.RowRange, добавил .Update в сводную таблицу при обновлении запроса мощности sh. Это решило все проблемы.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...