时间戳

首页 > 解决方案 > 我想排序，然后在多个工作簿的范围内删除

excel - 我想排序，然后在多个工作簿的范围内删除

问题描述

我有一个使用 Vlookups 来引用数据透视表的范围。我的 VBA 代码成功更新了数据透视表，然后对范围进行了排序，以使“#N/A”值位于最后。

尽我所能描述：整个表格有 2 个部分，基于 2 个类别。B 列包含 Vlookups 的所有引用（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”

标签： excelvbawith-statement

解决方案

你可以创建一个这样的子

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

推荐阅读