循环数字以创建一个大表

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 的端点依赖于 @987654329 @。我们打印到行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 应用程序窗口中

Answer 2

@jack 这就是我阅读这段代码的方式。检查第 2 - 25 列，第 2 - 152 行的所有单元格，如果其中一个大于 Z2，则输入 Zloop，开始检查接下来的 30 行，看看是否有任何一个更小。如果是这样，什么也不做，如果是，在单元格 153 中，y = 列 1 同一行，转到下一列..问题：为什么 Z 只检查 30？为什么不让它检查剩余的 152 ...z= 1 到 152 - x ？

无论如何我认为这是你想要做的，创建另一个变量说

DIM Result As Integer

Result = 153

''then below
If check = True Then                    'If the check doesn't fail
 ''.Cells(153, y) = Int(.Cells(x, 1))  'Set cell 153 to the energy level
 .Cells(Result, y) = Int(.Cells(x, 1))  'Set cell 153 to the energy level
Result = Result + 1
EXIT FOR

Answer 3

为什么要使用三个循环？

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

---

Sub OutputEnergyToSheet(TheSheet As String)
    Dim check as Boolean
    Dim rng as Range
    Dim c
    Dim ELevel as integer
    'Clear the range where we store the #N/A or Energy Outputs
    With Sheets(TheSheet)
        ' set all cells in row 153 = 0
        .Range("B153:Y153").value = 0 
        ELevel = .cells(2,26)
        ' Your range
        set rng = .Range(.Cells(2,2), .cells(25, 153))

        ' Loop through all cells in range
        For each c in rng.cells
            ' If value is greater then Z2 and respective column in row 153 = 0 and cell is not in 153 then change 153 = respective row column 1 
            If c.value > ELevel and .cells(153, c.column) = 0 and c.row <> 153 Then
                 .cells(153,c.column) = .cells(c.row, 1)
            ' If value is less then Z2 and cell is not in 153 then change 153 = 0
            elseif c.value < ELevel and c.row <> 153 then
                 .cells(153, c.column) = 0
            ' Clean up - if cell is in row 153 and value = 0 then change to "N/A"
            elseif c.row = 153 and c.value = 0 then
                c.value = "N/A"
            end if
        Next c
    End With
End Sub

如果我误解了，请告诉我