根据其他工作表中的单元格条件删除行



我有一个相对简单的问题。目前,我有一些代码运行良好,但效率不高。我有大约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

我现在正在处理模板提交的重复,所以下面的练习变成了删除,而不仅仅是复制和粘贴。我需要一些示例代码来检查表(3)上的范围("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列中,我将使用什么代码来检查,如果是,则删除?只有这样才能运行粘贴操作。这里的目的是删除已经导入我的工作表中的任何成本中心的数据。

希望问题和问题描述清楚?我需要一篇新文章的原因是,对于一个新手来说,很难将已经发布的例子适应我当前的代码。

感谢您的专业知识!

每个工作表都有一个NameCodeName。默认情况下,两者相同。但是,一旦用户更改了选项卡名称,它们就会有所不同。这是因为CodeName无法从电子表格界面更改。更改工作表需要访问VBA。因此,如果您在代码中按CodeName引用工作表,则用户可以为工作表指定任何名称,而不会影响代码。实例

Name="MySheet"CodeName="Sheet1"(您可以在VBE的属性窗口中更改此名称)现在参考代码中的表格,如下所示。

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

最新更新