Question

我的问题是关于将命名范围名称添加到工作表（从txt文件导入）中的数据中，同时删除多余的行。

为此，它使用数据的特殊性，该数据有时具有以“ a”开头的行。标签的名称由该行给出，这是唯一的。这些行之间以“ a”开头的行应添加命名范围名称。

我正在使用以下代码，但是运行此代码1000行需要25秒，接下来的1000行需要80-85秒，等等。处理时间成倍增加，尽管应该相等（？）。

有什么办法可以改善处理时间吗？我每张纸有两万多行，多张纸，现在一张纸可能要花24小时...

Sub Test()

Dim rng As Range
Dim named_range_name As String
Dim named_range_location As String
Dim start_row As Integer
Dim end_row As Integer
Dim x As Long
Application.ScreenUpdating = False

  NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
  Cells(NumRows + 1, "A").Value = "abcd"
  Range("A1").Select


  For x = 1 To NumRows + 1
     If Left(ActiveCell.Value, 1) = "a" And ActiveCell.Row = 1 Then
        start_row = ActiveCell.Row + 1
        named_range_name = Cells(ActiveCell.Row, "A").Value
        Else
            If Left(ActiveCell.Value, 1) = "a" And ActiveCell.Row <> 1 Then
                end_row = ActiveCell.Row - 1
                named_range_location = "A" & start_row & ":J" & end_row
                Set rng = Range(named_range_location)
                ThisWorkbook.Names.Add Name:=named_range_name, RefersTo:=rng
                start_row = ActiveCell.Row + 1
                named_range_name = Cells(ActiveCell.Row, "A").Value
            End If
     End If


     If ActiveCell.Value = "bcd" Then ActiveCell.EntireRow.Delete

     If ActiveCell.Value = "efgh" Then ActiveCell.EntireRow.Delete

     ActiveCell.Offset(1, 0).Select

  Next



End Sub

vba脚本之前的数据示例：

a008020a018024

bcd

efgh

unu False      3      3     21      7      5.59/  5.09      5.50/  5.01

doi False      2      2     22     11      8.79/  7.99      8.65/  7.87

trei False      4      4     20      5     15.98/ 14.53     11.77/ 10.70

patru False     11      2     22      2     17.59/ 16.00     14.07/ 12.80

cinci False     23      1     23      1     18.28/ 16.62     15.53/ 14.13

saseFalse      0      0     24      1     19.17/ 17.44     18.87/ 17.17

数据具有以上结构的多个块。每个此类块都有一个唯一的标签，该标签以“ a”开头，后跟一堆数字。该块具有可变的行数。两个这样的标签之间的数据必须...好了，被标签了。

因此，如果A1有一个标签，而A12有下一个标签，则宏应删除该范围内的多余行，并用来自A1的标签来标记剩余的数据。然后继续执行A12和A20之间的程序段（例如）并重复该操作，并使用A12中的标签对其进行标记。

问题似乎不在于添加范围名称，而在于循环本身（或填充循环的其他内容）。我决定只对前1000行多次运行循环，而不退出Excel（因此先运行一次，然后再次运行，依此类推）。结果如下：

第一次跑步：28秒；第二次跑步：113秒；第三轮：293秒；第四轮：473秒

我评论了命名范围的添加，执行时间是（相同的情况，对于前1000行多次运行循环，而没有退出Excel）。结果是：

第一次跑步：27秒；第二次跑步：129秒；等

帮助！

Answer 1

根据我能从您的代码中解密的信息。

1-选择A1并结束（向下）最后一个单元格+1，然后使该单元格=“ abc”

2-您不知道如何从A2开始，所以您有了if cell starts with a then rowstart=2

在每个单元格中进行3次循环，找到“ bcd”或“ efgh”并删除行

当您到达原始的“ abc”时4-停止循环

5-用A1中的值命名剩余单元格范围

我发现删除行的一列中的行值的最快方法是使用VBA replace（）函数并将其替换为空格，然后可以使用特殊单元格删除空格。

我在您的代码中注意到，您正在使用end(xldown)，该代码向我显示您的数据中没有空白，因此可以使用空白替换那些特定的单元格。

对于几千行，结果非常快，尽管不确定约几万行。

检查一下。

Sub Button1_Click()
    Dim sh As Worksheet, rng As Range
    Set sh = ActiveSheet

    With sh
        Set rng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

        With rng
            .Replace what:="bcd", replacement:="", lookat:=xlPart, MatchCase:=False
            .Replace what:="efgh", replacement:="", lookat:=xlPart, MatchCase:=False
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With

        .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Row).Name = .Range("A1").Value
    End With

End Sub

Excel 2010 For Next Loop变得越来越慢

1 个答案:

检查一下。