excel - 以更有效的方式根据单元格值删除两个不同工作表上的行[VBA Excel]
问题描述
我有两个不同的工作表,每个工作表的行数相同。在 RI 列中,根据行有“新”或“旧”(这是一个动态值)。我想要做的是,如果 Worksheet1 中的一行在 R 列中包含“旧”,则在 Worksheet1 和 Worksheet2 中删除该行。
现在,我为此尝试了两个代码:
Dim w1 As Worksheet
Dim w2 As Worksheet
Set w1= Worksheets("Sheet1")
Set w2= Worksheets("Sheet2")
'-----------------------------------------------------
'Code 1
'-----------------------------------------------------
Application.ScreenUpdating = False
For r = w1.UsedRange.Rows.Count To 1 Step -1
If Cells(r, "R") = "Old" Then
w1.Rows(r).EntireRow.Delete
w2.Rows(r).EntireRow.Delete
End If
Next r
Application.ScreenUpdating = True
'-----------------------------------------------------
'Code 2
'-----------------------------------------------------
Dim i As Long
i = 1
Application.ScreenUpdating = False
Do While i <= w1.Range("R1").CurrentRegion.Rows.Count
If InStr(1, w1.Cells(i, 18).Text, "Old", vbTextCompare) > 0 Then
w1.Cells(i, 1).EntireRow.Delete
w2.Cells(i, 1).EntireRow.Delete
Else
i = i + 1
End If
Loop
Application.ScreenUpdating = True
通常我有 +800 行,所以代码 1 可以按需要工作,但有时需要太长时间,比如 3 分钟。代码 2 到目前为止卡住了。
这样做的有效方法是什么?
解决方案
删除工作表中的行
实施联盟应大大加快这一进程。
编码
Sub DeleteRowsInSheets()
Const cSheet1 As Variant = "Sheet1" ' First Worksheet Name/Index
Const cSheet2 As Variant = "Sheet2" ' First Worksheet Name/Index
Const cVntCol As Variant = "R" ' Search Column Letter/Number
Const cStrCriteria As String = "Old" ' Search Criteria String
Dim rngU1 As Range ' Union Range 1
Dim rngU2 As Range ' Union Range 2
Dim LastUR As Long ' Last Used Row
Dim i As Long ' Row Counter
With Worksheets(cSheet1)
' Calculate Last Used Row.
If .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
Is Nothing Then Exit Sub
LastUR = .Cells.Find("*", , , , , 2).Row
' Add found cells to Union Ranges.
For i = 1 To LastUR
If StrComp(.Cells(i, cVntCol), cStrCriteria, vbTextCompare) = 0 Then
If Not rngU1 Is Nothing Then
Set rngU1 = Union(rngU1, .Cells(i, 1))
Set rngU2 = Union(rngU2, Worksheets(cSheet2).Cells(i, 1))
Else
Set rngU1 = .Cells(i, 1)
Set rngU2 = Worksheets(cSheet2).Cells(i, 1)
End If
End If
Next
End With
' Delete rows.
If Not rngU1 Is Nothing Then
rngU1.EntireRow.Delete ' Hidden = True
rngU2.EntireRow.Delete ' Hidden = True
Set rngU2 = Nothing
Set rngU1 = Nothing
End If
End Sub
推荐阅读
- php - 带有子文件夹和相对链接的 Wordpress 多站点
- python - Python Tkinter Tk() 对象在最大化时捕捉到左上角
- amazon-quicksight - 快速隐藏共享仪表板选项
- javascript - 仅 Firefox 浏览器中的弹出问题
- javascript - 引导模式中的两个 Angular 路由器出口
- c# - C# await X 和 .Result 在 ToDictionary() 中不等效?
- angular - 角材质sidenav动态高度
- python - cv2.imshow 命令不起作用 propley 。显示不完整的图像
- oracle - Oracle 时区行为不一致
- mysql - 在nodejs的单个api调用中执行两个sql查询