vba - 循环数字以创建一个大表

Question

我有一个有效的代码，但我想为其添加更多功能。它目前正在做它应该做的事情，并加快了一些进程，但现在我认为它可以加快速度。我正在使用我在此处标记为已回答的解决方案:Using VBA to get a threshold value

但

我有这个代码:

Sub OutputEnergyToAllSheets()
Dim w
For Each w In ThisWorkbook.Worksheets
    If Not InStr(w.Name, "Total") > 0 And Not InStr(w.Name, "eV") Then
        OutputEnergyToSheet w.Name
    End If
Next w
End Sub

Sub OutputEnergyToSheet(TheSheet As String)
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'z = check the next 4 cells
Dim x, y, z, check
'Clear the range where we store the #N/A or Energy Outputs
With Sheets(TheSheet)
    .Range("B153:Y153") = vbNullString
    For y = 2 To 25
        For x = 2 To 152
            If .Cells(x, y) > .Range("Z2") Then  'If value is greater than Z2
                check = True                   'Let's check the next 4
                For z = 1 To 30                'If any of them fail
                    If .Cells(x + z, y) < .Range("Z2") Then
                        check = False          'The check fails
                        Exit For
                    End If
                Next z
                If check = True Then                    'If the check doesn't fail
                    .Cells(153, y) = Int(.Cells(x, 1))  'Set cell 153 to the energy level
                    Exit For
                End If
            End If
        Next x                                   'If no energy level was set - #N/A
        If .Cells(153, y) = vbNullString Then .Cells(153, y) = ""
    Next y
End With
End Sub

但是那行说:

for z = 1 to 30

我必须以 1 为增量从 0 更改为 100。它将这些值输出到所有工作表上应该出现的位置，然后我转到 sub 并增加值并重复。这些值在每个工作表中输出，除了第 153 行中的一些值。有没有办法让 0 在第 153 行中，1 在 154 中，2 在 155 中，等等直到 100？我理解这是否不可能，但我会花很多时间，因为我必须为许多工作簿经历这个过程。如果可以做到这一点，它将为我节省几个单调的忙碌工作时间。无论如何，感谢您的阅读。

Answer 1

对于第一个代码块，我尝试保留您问题中代码的一般结构。例如，我可以换掉最里面的两个 For单个 While 的循环环形。这会更有效，但需要进行重大的逻辑更改。不过我确实做了一些改变。我在开头而不是结尾将所有内容设置为“N/A”，并在最后一个 If 中添加了一个条件陈述。为了实现检查可变数量的连续单元格的新功能，我添加了另一个 For带计数器的循环 k围绕For带计数器的循环 z并以 z 为终点依赖于 k .我们打印到行 152 + k .

Sub OutputEnergyToSheet(TheSheet As String)
    'y = Columns to check: 2-25
    'x = Rows to check: 2-152
    'k = number of matches in a row to find
    'z = check the next (k - 1) cells
    Dim x, y, z, check, k
    'Clear the range where we store the N/A or Energy Outputs
    With Sheets(TheSheet)
        .Range("B153:Y252") = "N/A"
        For y = 2 To 25
            For x = 2 To 151
                If .Cells(x, y) > .Range("Z2") Then  'If value is greater than Z2
                    For k = 1 To 100
                        check = True                   'Let's check the next k - 1
                        For z = 1 To k - 1             'If any of them fail
                            If .Cells(x + z, y) <= .Range("Z2") Then
                                check = False          'The check fails
                                Exit For
                            End If
                        Next z
                        If check = True And .Cells(152 + k, y) = "N/A" Then
                            .Cells(152 + k, y) = Int(.Cells(x, 1))
                        End If
                    Next k
                End If
            Next x
        Next y
    End With
End Sub

在我做这一切之前，我把我自己的方法放在一起，它更干净并且运行 很多快点。下面的代码逐步减少行并维护它找到的连续匹配数的运行计数。它消除了很多检查，因为它只检查任何给定的单元格一次。总共减少 2 个循环!上面的代码在内部循环中多次检查单元格。通过维护数组中的值(在 Excel 中读取/写入速度很慢)和/或维护我已经为当前列实现的最大长度的计数器，下面的代码可能会更好。我将大部分数字存储为可以轻松自信地修改的变量。

Sub EfficientEnergy(ws As Worksheet)
    Dim r As Integer, c As Integer, ctr As Integer
    Dim compVal As Double
    Dim maxRow As Integer, maxCol As Integer, maxConsecutive As Integer
    maxRow = 151
    maxCol = 25
    maxConsecutive = 100
    compVal = ws.Cells(2, 26).Value
    ws.Range(ws.Cells(maxRow + 2, 2), ws.Cells(maxRow + maxConsecutive + 1, maxCol)).Value = "N/A"
    For c = 2 To maxCol
        ctr = 0
        For r = 2 To maxRow
            If ws.Cells(r, c).Value > compVal Then
                ctr = ctr + 1
                If ws.Cells(maxRow + 1 + ctr, c).Value = "N/A" Then
                   ws.Cells(maxRow + 1 + ctr, c).Value = ws.Cells(r - ctr + 1, 1).Value
                End If
            Else
                ctr = 0
            End If
        Next r
    Next c
End Sub

我在测试中用来调用这些方法的代码是(只需注释掉你不使用的那个):

Public Sub GetConsecutiveVals()
    'OutputEnergyToSheet ("Sheet1")
    Call EfficientEnergy(ActiveWorkbook.Worksheets("Sheet1"))
End Sub

或在事件工作簿中的每个工作表上运行(未经测试):

Public Sub GetConsecutiveVals()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        'OutputEnergyToSheet (ws.Name)
        Call EfficientEnergy(ws)
    Next ws
End Sub

将所有代码放在工作簿的模块中。使用 Sheet1 中的数据打开您的工作簿(或将上面的代码更改为您的工作表名称)。点击 Alt + F8 然后运行 ​​GetConsecutiveVals 例程。如果在对话框窗口中没有看到该方法，请确保包含代码的工作簿和包含数据的工作簿位于同一个 Excel 应用程序窗口中