Я хочу отсортировать, а затем удалить в диапазоне в нескольких книгах - PullRequest
Новая
       12

Я хочу отсортировать, а затем удалить в диапазоне в нескольких книгах

0 голосов
/ 15 апреля 2019

У меня есть диапазон, который использует Vlookups для ссылки на сводную таблицу.мой код VBA успешно обновляет сводные таблицы, затем сортирует диапазон, так что значения «# N / A» являются последними.

Чтобы быть как можно более наглядным: вся таблица состоит из 2 частей, основанной на 2 категориях.Столбец B содержит все ссылки для просмотров (1,2,3 и т. Д.), А затем столбцы C: E.Затем сортируется первая категория (b2: e189), поэтому значения ошибок являются последними.затем вторая категория (b191: e8040).В настоящее время мне нужно пройти и вручную удалить (сдвинуть ячейки вверх, так как я хочу только удалить столбцы A: E) строк ошибок.

Существует несколько рабочих книг (wb2, wb3, wb4), к которым это будет применятьсяк.Таким образом, любая часть кода, показанного ниже, реплицируется несколько раз (с изменением wb #).

Мой код VBA до сих пор работает для сортировки категорий. Я не могу понять, как затем автоматически удалять (и сдвигать ячейки)вверх) значения ошибок.Можно ли это сделать в выражении «with ... end with»?

Private Sub CommandButton1_Click()

'name and set this workbook

Dim wb1 As Excel.Workbook
    Set wb1 = ThisWorkbook

'name and set variables to all provider workbooks

Dim wb2 As Excel.Workbook: Set wb2 = Workbooks.Open("H:\RVU Monthly Reports\2019 RVU Reports\Alonso_2019.xlsx")
Dim wb3 As Excel.Workbook: Set wb3 = Workbooks.Open("H:\RVU Monthly Reports\2019 RVU Reports\Apostolova_2019.xlsx")

'optimize macro speed
     Application.ScreenUpdating = False
     Application.EnableEvents = False
     Application.Calculation = xlCalculationManual

'Copying InvoiceDetail from Template to Provider Report
     wb1.Worksheets("InvoiceDetail").Range("A:BZ").Copy

'paste special_values to all workbooks
    wb2.Worksheets("InvoiceDetail").Range("A:BZ").PasteSpecial Paste:=xlPasteValues
    wb3.Worksheets("InvoiceDetail").Range("A:BZ").PasteSpecial Paste:=xlPasteValues

'Refresh Pivot Tables

 Dim pc As PivotCache

'Refresh all pivot tables

'  For Each pc In wb1.PivotCaches
'     pc.Refresh
'     Next pc
For Each Workbook In Application.Workbooks: Workbook.RefreshAll: Next Workbook


'Reset Macro Optimization Settings
Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic

'sort for worksheets


With wb2.Worksheets("Mar").Sort
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b2:e189")
    .Header = xlYes
    .Apply
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b191:e8040")
    .Header = xlYes
    .Apply
End With

With wb3.Worksheets("Mar").Sort
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b2:e189")
    .Header = xlYes
    .Apply
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b191:e8040")
    .Header = xlYes
    .Apply
End With


End Sub

Фактические результаты: все книги открываются, справочный лист копируется / вставляется, сводные сводки обновляются, а необходимые таблицы сортируются.Теперь мне нужно удалить «# N / A»

1 Ответ

0 голосов
/ 15 апреля 2019

вы можете создать подобную подпункту 

Public Sub DeleteRowsWithError(st As Worksheet)
    Dim c As Range
    For Each c In st.UsedRange
        c.Select
        If VBA.IsError(c) Then
            c.EntireRow.Delete
        End If
    Next c
End Sub

И в конце вашего кода вы можете добавить этот саб 

Private Sub CommandButton1_Click()

'name and set this workbook

Dim wb1 As Excel.Workbook
    Set wb1 = ThisWorkbook

'name and set variables to all provider workbooks

Dim wb2 As Excel.Workbook: Set wb2 = Workbooks.Open("H:\RVU Monthly Reports\2019 RVU Reports\Alonso_2019.xlsx")
Dim wb3 As Excel.Workbook: Set wb3 = Workbooks.Open("H:\RVU Monthly Reports\2019 RVU Reports\Apostolova_2019.xlsx")

'optimize macro speed
     Application.ScreenUpdating = False
     Application.EnableEvents = False
     Application.Calculation = xlCalculationManual

'Copying InvoiceDetail from Template to Provider Report
     wb1.Worksheets("InvoiceDetail").Range("A:BZ").Copy

'paste special_values to all workbooks
    wb2.Worksheets("InvoiceDetail").Range("A:BZ").PasteSpecial Paste:=xlPasteValues
    wb3.Worksheets("InvoiceDetail").Range("A:BZ").PasteSpecial Paste:=xlPasteValues

'Refresh Pivot Tables

 Dim pc As PivotCache

'Refresh all pivot tables

'  For Each pc In wb1.PivotCaches
'     pc.Refresh
'     Next pc
For Each Workbook In Application.Workbooks: Workbook.RefreshAll: Next Workbook


'Reset Macro Optimization Settings
Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic

'sort for worksheets


With wb2.Worksheets("Mar").Sort
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b2:e189")
    .Header = xlYes
    .Apply
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b191:e8040")
    .Header = xlYes
    .Apply
End With

With wb3.Worksheets("Mar").Sort
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b2:e189")
    .Header = xlYes
    .Apply
    .SortFields.Add Key:=Range("c3"), Order:=xlAscending
    .SetRange Range("b191:e8040")
    .Header = xlYes
    .Apply
End With

call DeleteRowsWithError(wb2)
call    DeleteRowsWithError (wb3)
End Sub
...