根据另一个工作表中的单元格条件删除行

时间:2019-01-16 11:31:30

标签: excel vba object

我有一个相对简单的问题。目前,我有一些运行良好但效率不高的代码。我有大约500个成本中心,每个成本中心都有自己的工作簿,这些工作簿已合并到一个中央存储库中(参考-下面代码中的Wb2)。代码副本从每个打开的模板(Wb1)到我的合并(Wb2)。在下面标记了当前代码之后,将列举问题:


Sub CopyData()
    Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
    Dim rngToCopy1 As Range
    Dim rngToCopy2 As Range
    Dim rngToCopy3 As Range
    Dim rngToCopy4 As Range
    Dim rngToCopy5 As Range
    Set wb2 = ThisWorkbook
    Application.Calculation = xlManual

    For Each wB In Application.Workbooks
            If Not Left(wB.Name, 18) = "Consolidation Test" Then
            Set Wb1 = wB
            Exit For
            End If
    Next

        'Forecast Data
        With Wb1.Sheets(1)
        Set rngToCopy1 = .Range("A11:O11", .Cells(.Rows.Count, "A").End(xlUp))
        End With
            wb2.Sheets(7).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count, 15).Value = rngToCopy1.Value
            wb2.Sheets(7).Range("P" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count).Value = Sheets(3).Range("J1").Value

        'Planning (budget) Data
        With Wb1.Sheets(3)
        Set rngToCopy2 = .Range("A10:S10", .Cells(.Rows.Count, "A").End(xlUp))
        End With
            wb2.Sheets(8).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy2.Rows.Count, 19).Value = rngToCopy2.Value
            wb2.Sheets(8).Range("T" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy2.Rows.Count).Value = Sheets(3).Range("J1").Value

        'Travel Data
        With Wb1.Sheets(5)
        Set rngToCopy3 = .Range("A6:AA6", .Cells(.Rows.Count, "A").End(xlUp))
        End With
            wb2.Sheets(9).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy3.Rows.Count, 27).Value = rngToCopy3.Value
            wb2.Sheets(9).Range("AB" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy3.Rows.Count).Value = Sheets(3).Range("J1").Value

        'Vacancy Data
        With Wb1.Sheets(6)
        Set rngToCopy4 = .Range("A6:O6", .Cells(.Rows.Count, "A").End(xlUp))
        End With
            wb2.Sheets(10).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy4.Rows.Count, 15).Value = rngToCopy4.Value
            wb2.Sheets(10).Range("P" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy4.Rows.Count).Value = Sheets(3).Range("J1").Value

        'Manpower Data
        With Wb1.Sheets(7)
        Set rngToCopy5 = .Range("A6:O6", .Cells(.Rows.Count, "A").End(xlUp))
        End With
            wb2.Sheets(11).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy5.Rows.Count, 15).Value = rngToCopy5.Value
            wb2.Sheets(11).Range("P" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy5.Rows.Count).Value = Sheets(3).Range("J1").Value



End Sub

我现在正在处理模板提交的重复,因此下面的练习将成为删除操作之一,而不仅仅是复制和粘贴。我需要一些示例代码来检查Sheets(3)上的Range(“ J1”)是否出现在我粘贴到的其他任何范围内:

With Wb1.Sheets(1)
        Set rngToCopy1 = .Range("A11:O11", .Cells(.Rows.Count, "A").End(xlUp))
        End With
            wb2.Sheets(7).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count, 15).Value = rngToCopy1.Value
            wb2.Sheets(7).Range("P" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count).Value = Sheets(3).Range("J1").Value

换句话说,我将使用什么代码检查工作表3上的J11是否首先出现在工作表7的P列中的任何位置?只有这样,粘贴操作才能运行。这样做的目的是从已经导入到我的工作表的所有成本中心中删除数据。

希望问题和问题描述清楚吗?我需要一个新帖子的原因是,对于新手来说,很难将已经发布的示例修改为适合我的当前代码。

感谢您的专业知识!

1 个答案:

答案 0 :(得分:0)

每个工作表都有一个Name和一个CodeName。默认情况下,它们都是相同的。但是,一旦用户更改了选项卡名称,他们将有所不同。这是因为无法从电子表格界面更改CodeName。它需要访问VBA才能进行更改。因此,如果您在代码中通过工作表的CodeName引用工作表,则用户可以为工作表指定任何名称,而不会打扰您的代码。例子。

名称=“ MySheet” CodeName =“ Sheet1”(您可以在VBE的属性窗口中更改此名称) 现在,请参考下面的代码表。

Debug.Print Worksheets("MySheet").Name
Debug.Print Sheet1.Name