求高手写一代码

云朵中的民族 · 发表于 2013-1-2 20:52

本帖最后由云朵中的民族于 2013-1-3 11:44 编辑

具体求助内容都写在附件中了，多谢高手帮忙！

求助.rar (5.88 KB, 下载次数: 30)

yangyangzhifeng · 发表于 2013-1-2 22:57

试试看，清除sheet2的合并单元格

复制代码

yangyangzhifeng · 发表于 2013-1-2 22:58

请见附件

求助.rar (12.89 KB, 下载次数: 13)

云朵中的民族 · 发表于 2013-1-2 23:41

本帖最后由云朵中的民族于 2013-1-2 23:46 编辑

yangyangzhifeng 发表于 2013-1-2 22:58
请见附件

感谢老师，假如我的数据源是从第四行开始的，代码里需要哪些地方进行修改，还有我加个按钮计算后，怎么把第一行的字段给弄没有了，sheet3作数据源：

求助.rar (16.91 KB, 下载次数: 4)

yangyangzhifeng · 发表于 2013-1-3 00:49

本帖最后由 yangyangzhifeng 于 2013-1-3 01:04 编辑

你的模拟数据不合理吧，民航D0884这辆车只有一笔数据，不知要怎么计算行驶里程，现在按直接以里程表读数代替

求助.rar (17.14 KB, 下载次数: 16)

云朵中的民族 · 发表于 2013-1-3 10:56

yangyangzhifeng 发表于 2013-1-3 00:49
你的模拟数据不合理吧，民航D0884这辆车只有一笔数据，不知要怎么计算行驶里程，现在按直接以里程表读数代替 ...

谢谢老师的解答，忘记说了，假如只有一条记录，视为首次记录，读数也就是起始里程，行驶里程就为0

yangyangzhifeng · 发表于 2013-1-3 11:02

本帖最后由 yangyangzhifeng 于 2013-1-3 11:03 编辑

云朵中的民族发表于 2013-1-3 10:56
谢谢老师的解答，忘记说了，假如只有一条记录，视为首次记录，读数也就是起始里程，行驶里程就为0

你自己改一下吧，现在将读数直接处理为里程了

云朵中的民族 · 发表于 2013-1-3 11:05

yangyangzhifeng 发表于 2013-1-3 00:49
你的模拟数据不合理吧，民航D0884这辆车只有一笔数据，不知要怎么计算行驶里程，现在按直接以里程表读数代替 ...

假如计算结果第二行起本来为空的话，点击按钮，会得到计算结果，可是字段全被清除了，请问应该怎么处理？

yangyangzhifeng · 发表于 2013-1-3 11:18

云朵中的民族发表于 2013-1-3 11:05
假如计算结果第二行起本来为空的话，点击按钮，会得到计算结果，可是字段全被清除了，请问应该怎么处理？ ...

试试看，一并修正了

Sub test()
Dim ar, br, i&, j&, cp$, n&, lc, mt
Sheet3.Select
Sheet3.Range("a4:s" & Sheet3.Range("a65536").End(3).Row).Sort key1:=[f4], key2:=[n4], header:=xlYes
ar = Sheet3.Range("a4:s" & Sheet3.Range("a65536").End(3).Row)
ReDim br(1 To UBound(ar), 1 To 8)
' n = 1: cp = ar(2, 6): lc = ar(2, 18)
For i = 2 To UBound(ar)
If ar(i, 6) <> cp Then
n = n + 1: cp = ar(i, 6)
br(n, 1) = cp
br(n, 2) = 1: br(n, 3) = ar(i, 15): br(n, 4) = ar(i, 16)
If n > 1 Then
br(n - 1, 5) = br(n, 5) + ar(i - 1, 18) - lc
If mt <> "" Then br(n - 1, 6) = ar(i - 1, 19) - mt
If br(n - 1, 5) <> 0 Then br(n - 1, 7) = br(n - 1, 4) * 100 / br(n - 1, 5)
If br(n - 1, 6) > 0 Then br(n - 1, 8) = br(n - 1, 4) / br(n - 1, 6)
End If
lc = ar(i, 18): mt = ar(i, 19)
Else
br(n, 2) = br(n, 2) + 1
br(n, 3) = br(n, 3) + ar(i, 15)
br(n, 4) = br(n, 4) + ar(i, 16)
If i > 2 Then
If ar(i, 18) < ar(i - 1, 18) Then
br(n, 5) = br(n, 5) + ar(i - 1, 18) - lc: lc = 0
End If
End If
End If
Next
br(n, 5) = br(n, 5) + ar(i - 1, 18) - lc
If mt <> "" Then br(n, 6) = ar(i - 1, 19) - mt
If br(n, 5) Then br(n, 7) = br(n, 4) * 100 / br(n, 5)
If br(n, 6) > 0 Then br(n, 8) = br(n, 4) / br(n, 6)
If Sheet2.Range("a65536").End(3).Row > 1 Then Sheet2.Range("a2:h" & Sheet2.Range("a65536").End(3).Row).ClearContents
Sheet2.Range("a2").Resize(n, 8) = br
Sheet2.Select
End Sub

复制代码

云朵中的民族 · 发表于 2013-1-4 18:28

yangyangzhifeng 发表于 2013-1-3 11:02
你自己改一下吧，现在将读数直接处理为里程了

老师你好，目前还没研究透你的代码，我想在报表里增加两列，显示车型和所属单位，麻烦老师帮忙再修改一下代码，谢谢了！

111.rar (31 KB, 下载次数: 8)

		自动登录	找回密码
密码			免费注册

[已解决] 求高手写一代码