循环数字以创建一个大表

时间:2015-06-19 16:28:40

标签: excel vba excel-vba indexing

我有一个可行的代码,但我想为它添加更多功能。它目前正在做它应该做的事情,并加快了一些过程,但现在我认为它可以加速更多。我正在使用我在此处标记为已回答的解决方案: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,1 2在155等等,直到100?我知道如果这是不可能的,但是我需要花费很多时间,因为我必须为许多工作簿完成这个过程。如果可以做到这一点,它将为我节省几个单调的忙碌工作时间。无论如何,感谢您的阅读。

3 个答案:

答案 0 :(得分:1)

对于第一个代码块,我试着继续使用你问题中代码的一般结构。例如,我可以为单个For循环换出最里面的两个While循环。这样会更有效,但需要进行重大的逻辑更改。我确实做了一些改变。我将所有内容都设置为&#34; N / A&#34;在开始而不是结束时,我在最后If语句中添加了一个条件。为了实现检查连续单元格的可变数量的新功能,我在计数器For的{​​{1}}循环周围添加了一个带有计数器k的{​​{1}}循环,并作为结束点For依赖于z。我们打印到行z

k

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

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

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

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

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

答案 1 :(得分:0)

@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

答案 2 :(得分:0)

为什么要使用三个循环?

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

如果我误解了

,请告诉我