循环遍历数字以创建一个大的 table
Looping through numbers to create a large table
我有一个有效的代码，但我想为其添加更多功能。它目前正在做它应该做的事情，并加快了一些进程，但现在我认为它可以进一步加快。我正在使用我在此处标记为已回答的解决方案：
但是
我有这个代码：
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。它会在所有工作表上输出这些值，然后我转到子项并增加值并重复。这些值在每个工作表中输出，除了第 153 行中的一些值。有没有办法让 0 在第 153 行，1 在 154，2 在 155，等等直到 100？我知道这是否不可能，但这会花费我大量时间，因为我必须为许多工作簿经历这个过程。如果可以做到这一点，它将为我节省几个单调的繁忙工作时间。总之，感谢阅读。
@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
对于第一个代码块，我尝试保留您问题中代码的一般结构。例如，我可以将最里面的两个 For 循环换成一个 While 循环。这会更有效，但需要进行重大的逻辑更改。不过我确实做了一些改变。我在开始而不是结束时将所有内容设置为 "N/A"，并在最后一个 If 语句中添加了一个条件。为了实现检查可变数量的连续单元格的新功能，我在带有计数器 z 的 For 循环周围包含了另一个带有计数器 k 的 For 循环并设置了终点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
在我做这一切之前，我把我自己的方法放在一起，它更干净，运行s much 更快。下面的代码逐行递减，并维护一个 运行ning 计数，计算它找到的连续匹配项的数量。它消除了很多检查，因为它只检查任何给定的单元格一次。总共减少 2 个循环！上面的代码在内循环中多次检查一个单元格。通过维护数组中的值，下面的代码可能会更好（read/write in Excel 很慢）and/or 维护我已经为当前列实现的最大长度的计数器。我将大部分数字存储为可以轻松自信地修改的变量。
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
或 运行 在活动工作簿（未测试）中的每项工作sheet：
Public Sub GetConsecutiveVals()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'OutputEnergyToSheet (ws.Name)
Call EfficientEnergy(ws)
Next ws
End Sub
将所有代码放在工作簿的一个模块中。打开包含 Sheet1 中数据的工作簿（或将上面的代码更改为您的 sheet 名称）。按 Alt + F8 然后 运行 GetConsecutiveVals 例程。如果您在对话框 window 中没有看到该方法，请确保包含代码的工作簿和包含您的数据的工作簿位于同一个 Excel 应用程序 window
一个循环就可以了，为什么要用三个循环？
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
如果理解有误请告知
我有一个有效的代码，但我想为其添加更多功能。它目前正在做它应该做的事情，并加快了一些进程，但现在我认为它可以进一步加快。我正在使用我在此处标记为已回答的解决方案：
但是
我有这个代码：
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。它会在所有工作表上输出这些值，然后我转到子项并增加值并重复。这些值在每个工作表中输出，除了第 153 行中的一些值。有没有办法让 0 在第 153 行，1 在 154，2 在 155，等等直到 100？我知道这是否不可能，但这会花费我大量时间，因为我必须为许多工作簿经历这个过程。如果可以做到这一点，它将为我节省几个单调的繁忙工作时间。总之，感谢阅读。
@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
对于第一个代码块，我尝试保留您问题中代码的一般结构。例如，我可以将最里面的两个 For 循环换成一个 While 循环。这会更有效，但需要进行重大的逻辑更改。不过我确实做了一些改变。我在开始而不是结束时将所有内容设置为 "N/A"，并在最后一个 If 语句中添加了一个条件。为了实现检查可变数量的连续单元格的新功能，我在带有计数器 z 的 For 循环周围包含了另一个带有计数器 k 的 For 循环并设置了终点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
在我做这一切之前，我把我自己的方法放在一起，它更干净，运行s much 更快。下面的代码逐行递减，并维护一个 运行ning 计数，计算它找到的连续匹配项的数量。它消除了很多检查，因为它只检查任何给定的单元格一次。总共减少 2 个循环！上面的代码在内循环中多次检查一个单元格。通过维护数组中的值，下面的代码可能会更好（read/write in Excel 很慢）and/or 维护我已经为当前列实现的最大长度的计数器。我将大部分数字存储为可以轻松自信地修改的变量。
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
或 运行 在活动工作簿（未测试）中的每项工作sheet：
Public Sub GetConsecutiveVals()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'OutputEnergyToSheet (ws.Name)
Call EfficientEnergy(ws)
Next ws
End Sub
将所有代码放在工作簿的一个模块中。打开包含 Sheet1 中数据的工作簿（或将上面的代码更改为您的 sheet 名称）。按 Alt + F8 然后 运行 GetConsecutiveVals 例程。如果您在对话框 window 中没有看到该方法，请确保包含代码的工作簿和包含您的数据的工作簿位于同一个 Excel 应用程序 window
一个循环就可以了，为什么要用三个循环？
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
如果理解有误请告知