Question

我正在创建一个宏，它将在列中搜索超过设定阈值的值，然后将这些值以及行中的其他一些值复制到另一个表中的表中。

我已经使用for循环实现了它，但是我目前只使用一个小数据集（~200行），它需要处理大约60000左右的行，并且根据我的循环经验趋势在使用大量数据时效率低下！

这就是我所拥有的：

Sub MondayTable()

Dim ShMonday As Worksheet
Dim ShSummary As Worksheet


Set ShMonday = ThisWorkbook.Sheets("Monday Data")
Set ShSummary = ThisWorkbook.Sheets("Summary")

Dim rCount As Integer
Dim AlertRow As Integer
Dim ActionRow As Integer

ActionRow = 17
AlertRow = 17

' Action Level

For rCount = 310 To 550

If ShMonday.Cells(rCount, 12) > 0.5 Then

    ShSummary.Cells(ActionRow, 5) = ShMonday.Cells(rCount, 12)   ' PPV
    ShSummary.Cells(ActionRow, 4) = ShMonday.Cells(rCount, 7)   ' Time

    ActionRow = ActionRow + 1

End If

' Alert Level

If ShMonday.Cells(rCount, 12) > 0.3 And ShMonday.Cells(rCount, 12) < 0.5 Then

     ShSummary.Cells(AlertRow, 3) = ShMonday.Cells(rCount, 12)   ' PPV
     ShSummary.Cells(AlertRow, 2) = ShMonday.Cells(rCount, 7)   ' Time

AlertRow = AlertRow + 1

End If


Next rCount


End Sub

我想补充的另一件事是我正在创建的表格总结了每天超过阈值的数字，而且目前我每个都有一个按钮。如何只使用一个按钮执行相同的功能，在不同工作表上搜索数据，输出进入摘要表中的相邻列？

此外，虽然我在这里，如果可以在开头添加一行，清除表格的当前内容，这将是一个奖励！

谢谢，

克里斯

Answer 1

'清除内容使用类似这样的内容

ShSummary.Columns（ “C：C”）clearContents中。 ShSummary.Columns。（ “d：d”）clearContents中

“或

ShSummary.Columns（ “C：d”）。clearContents中

'为了提高效率，您可以保存ppv值而不是多次引用它。

Dim ppv

如果ppv =“”那么'您还可以先检查它是否为空白，然后跳到最后 rcount = 60000'或者需要注意整数限制 “虽然你几乎就在那里其他 ppv = cdbl（ShMonday.Cells（rCount，12））

 If ppv > 0.5 Then 'etc....

结束如果

'最后你可以调用你的第二个程序，这将消除第二个按钮的需要

调用otherprocedurename

Answer 2

您可以通过首先对相关列上的数据块进行排序来减少for循环必须经历的迭代：

'declare ranges to leverage Excel's built-in sort capability
Dim DataBlock As Range, SortHeader As Range

'assuming the column header is one row up from the start of the loop and
'the 12th column is the last in the block of data
Set SortHeader = ShMonday.Cells(309, 12)
Set DataBlock = ShMonday.Range(ShMonday.Cells(309, 1), ShMonday.Cells(550, 12))

'sort the data block in descending order
DataBlock.Sort Key1:=SortHeader, Order1:=xlDescending, Header:=xlYes

然后，使用已排序的数据块，您可以在越过低阈值时退出for循环：

For rCount = 310 To 550

    ' Action level    
    If ShMonday.Cells(rCount, 12) > 0.5 Then
        ShSummary.Cells(ActionRow, 5) = ShMonday.Cells(rCount, 12)   ' PPV
        ShSummary.Cells(ActionRow, 4) = ShMonday.Cells(rCount, 7)   ' Time
        ActionRow = ActionRow + 1
    End If

    ' Alert Level
    If ShMonday.Cells(rCount, 12) > 0.3 And ShMonday.Cells(rCount, 12) < 0.5 Then
        ShSummary.Cells(AlertRow, 3) = ShMonday.Cells(rCount, 12)   ' PPV
        ShSummary.Cells(AlertRow, 2) = ShMonday.Cells(rCount, 7)   ' Time
        AlertRow = AlertRow + 1
    End If

    'Exit the loop
    If ShMonday.Cells(rCount, 12) <= 0.3 Then 
        Exit For
    End If
Next rCount

将超过阈值的值复制到新工作表

2 个答案: