3个DO循环实现从第1行至工作表最大行的条件运算 |
|
作者：
来源：原创
|
如下图，左侧为原始表，右侧为要生成的结果区域，要求是，在有小计的对应行，生成对应的明细项，工程量为小计最近一次N列显示工程量的值。
人工费为工程量*K列小值人工费后的值。其他项类似。
分析：
我们可以从第1行开始，逐行进行判断，先判断到工程量后，记录工程量所在的行，便于提取工程量的数值，再继续向下，当判断出小计后，在对应的列位置生成值。
通过以上就可以形成简单的一次循环，如下面代码中的黄色和绿色循环。
Sub 工程量小计()
Dim rMax As Integer
rMax = ActiveSheet.UsedRange.Rows.Count ‘获取使用区域中最大的行号，并赋值给变更rMax
Debug.Print rMax
Cells(6, 18) = "工程量"
Cells(6, 19) = "人工费"
Cells(6, 20) = "材料费"
Cells(6, 21) = "机械费"
Cells(6, 22) = "企业管理费"
Cells(6, 23) = "利润"
Dim r As Integer, n As Integer
r = 1
Do While r < rMax
Do While Cells(r, 14) <> "工程量"
r = r + 1
If r > rMax Then
Exit Do
End If
Loop
n = r
' Debug.Print r
Do While Cells(r, 3) <> "小计"
r = r + 1
If r > rMax Then
Exit Do
End If
Loop
' Debug.Print r
Cells(r, 18) = Cells(n, 15)
Cells(r, 19) = Cells(n, 15) * Cells(r, 11)
Cells(r, 20) = Cells(n, 15) * Cells(r, 12)
Cells(r, 21) = Cells(n, 15) * Cells(r, 14)
Cells(r, 22) = Cells(n, 15) * Cells(r, 15)
Cells(r, 23) = Cells(n, 15) * Cells(r, 16)
r = r + 1
Loop
Range(Cells(6, 18), Cells(rMax, 23)).Borders.LineStyle = xlContinuous
ThisWorkbook.Save
End Sub
|
当我们需要使用vba获取某个表中使用单元格区域中最大的行数的时候，可以使用以下样式。
ActiveSheet.UsedRange.Rows.Count
活动工作表。使用区域。所有号中。总行数
我们需要对某个区域进行加边框时，可以配合rang和cells来使用，对应属性内容如下：
Range(Cells(6, 18), Cells(rMax, 23)).Borders.LineStyle = xlContinuous
区域（左上角位置cells位置，右下角cells位置）。边框。线样式
我们需要保存工作表时，可以使用：
ThisWorkbook.Save
通过测试，原始数据中如果有500行，进行循环完成的话，需要29秒左右。
参考网上的vba测算时间代码：
Sub 工程量小计()
Dim rMax As Integer
rMax = ActiveSheet.UsedRange.Rows.Count
Debug.Print rMax
'下面代码测算vba运行总时间
Dim dteStart As Date
Dim strTime As String
'中间代码为正常的循环
Cells(6, 18) = "工程量"
Cells(6, 19) = "人工费"
Cells(6, 20) = "材料费"
Cells(6, 21) = "机械费"
Cells(6, 22) = "企业管理费"
Cells(6, 23) = "利润"
Dim r As Integer, n As Integer
r = 1
Do While r < rMax
Do While Cells(r, 14) <> "工程量"
r = r + 1
If r > rMax Then
Exit Do
End If
Loop
n = r
' Debug.Print r
Do While Cells(r, 3) <> "小计"
r = r + 1
If r > rMax Then
Exit Do
End If
Loop
' Debug.Print r
Cells(r, 18) = Cells(n, 15)
Cells(r, 19) = Cells(n, 15) * Cells(r, 11)
Cells(r, 20) = Cells(n, 15) * Cells(r, 12)
Cells(r, 21) = Cells(n, 15) * Cells(r, 14)
Cells(r, 22) = Cells(n, 15) * Cells(r, 15)
Cells(r, 23) = Cells(n, 15) * Cells(r, 16)
r = r + 1
Loop
Range(Cells(6, 18), Cells(rMax, 23)).Borders.LineStyle = xlContinuous
ThisWorkbook.Save
'中间循环结束,并保存
strTime = Format((Timer - dteStart), "0.00000")
MsgBox "运行过程: " & strTime & "秒"
End Sub
|
对于这个运算效率，感觉并不算太高，实际运行的时候，6000行的文件，执行完成实际在2分钟
|
|
|
|
