Question

我编写了以下代码，该代码应该通过数据集运行，并删除与调用C1中的值不匹配的所有行。在我的原始代码中，我逐行删除，代码非常慢，所以现在我尝试将所有值添加到变量并删除最后的所有单元格。这可能吗？

Sub FixData()

Dim wbFeeReport As Workbook
Dim wsData As Worksheet
Dim wsData2 As Worksheet
Dim FrRngCount As Range
Dim x As Long
Dim y As Long
Dim varRows As Variant

Set wbFeeReport = ThisWorkbook
Set wsData = wbFeeReport.Worksheets("Data")
Set wsData2 = wbFeeReport.Worksheets("Data2")

Set FrRngCount = wsData.Range("D:D")
y = Application.WorksheetFunction.CountA(FrRngCount)

For x = y To 2 Step -1
If wsData.Range("J" & x).Value <> wsData2.Range("C1").Value Then
varRows = x
Else
wsData.Range("AF" & x).Value = wsData.Range("J" & x).Value
End If
Next x

wsData.Rows(varRows).EntireRow.Delete

End Sub

现在代码只删除最后一行，因为每次变量在循环中运行时都会被覆盖。关于如何在变量中存储所有值并删除最后不需要的行的任何建议？

谢谢你的帮助！

Answer 1

由于你需要一个包含所有行的范围，你可以在一个“运行中”收集它，如下所示：

Sub FixData()

  Dim wsData As Worksheet
  wsData = ThisWorkbook.Worksheets("Data")

  Dim val As Variant
  val = ThisWorkbook.Worksheets("Data2").Range("C1").Value

  Dim DelRows As Range, x As Long

  For x = 2 To wsData.Cells(wsData.Rows.Count, 4).End(xlUp).Row
    If wsData.Range("J" & x).Value <> val Then
      If DelRows Is Nothing Then
        Set DelRows = wsData.Rows(x)
      Else
        Set DelRows = Union(wsData.Rows(x), DelRows)
      End If
    Else
      wsData.Range("AF" & x).Value = wsData.Range("J" & x).Value
    End If
  Next x

  DelRows.EntireRow.Delete

End Sub

Answer 2

最快的方法是

将数据加载到数组中
将有效数据复制到第二个数组
清除范围内容
将第二个数组写回工作表

Sub FixData()
    Dim Source As Range
    Dim Data, Data1, TargetValue
    Dim x As Long, x1 As Long, y As Long

    Set Source = Worksheets("Data").Range("A1").CurrentRegion
    TargetValue = Worksheets("Data2").Range("C1")

    Data = Source.Value
    ReDim Data1(1 To UBound(Data, 1), 1 To UBound(Data, 2))

    For x = 1 To UBound(Data, 1)
        If x = 1 Or Data(x, 10) = TargetValue Then
            x1 = x1 + 1
            For y = 1 To UBound(Data, 2)
                Data1(x1, y) = Data(x, y)
            Next
        End If
    Next

    Source.ClearContents
    Source.Resize(x1).Value = Data1

End Sub

在变量中存储多个值并在sub的末尾删除行

2 个答案: