02套单价破解 (模板)讲座

谁有以前的那个套单价1.4版的，有的同志发给我一个，感激不尽，想研究一下接 http://bbs.co188.com/content/viewthread.php?tid=1173674&extra=%3D1&ofid=918&page=5 91楼.......讲. 这是模板的结构。里面有几张表隐藏了，你可以按以下步骤来显示他，菜单->工具->宏->

谁有以前的那个套单价1.4版的，有的同志发给我一个，感激不尽，想研究一下

接 http://bbs.co188.com/content/viewthread.php?tid=1173674&extra=%3D1&ofid=918&page=5
91楼.......讲.
模板文件的的表、其中有.jpg

这是模板的结构。里面有几张表隐藏了，你可以按以下步骤来显示他，菜单->工具->宏->

下面显示的是所有的表

上图中的最后一行visible 便是控制表隐藏与否的关键，你可以将其改为

在模板文件中,里面的数据大家先不要动.现在主要是了解里面的结构,02套单价程序,就是把这个文件的内容复制到新建工程文件的初始内容,其中有一个建模便是我们要修改的内容
(单价分析表)其实我们投标时这个模板与我们要求的主要内容是差不多的,大家只要修改一下表头就可以了,
在各省的定额与这个模板差不多,有的只是多了一项两项的,
以山东水利定额为例,山东定额内容里多了一项其他费用（%）,其计算式为,(人+材+机)*其它费用
我们可以改成这样,

同样安模也可以改
模板文件里有一个费率表大家可以看一下,了解一下整个文件的结构
模板的修改大家只要动一下表头内各项的位置就行了，“%%”里面的文字暂时就不要动了，这样就可以自定义模板了。[当然要改动的话，在你以后了解了整个程序也是可以的，]
当然在主程序的变动,我们以后再讲.
主程序。。。在02单价的安装目录下有一个文件，SL0208、大家把这个文件改为SL0208.xls
运行他，这时需要密码，（密码我不说了，大家自已去找，）
输入密码，，，，
编制一个工程单价
在新建的单价文件里打开菜单->工具->宏->vB编辑器
打开VBAProject（SL0208），这时要密码，输入密码
在EXCEL对象里有一个表，叫定额，我们这几天主要是来了解它，了解数据的格式和结构

修改表定额使之可见
当然大家也可去掉整个VBA工程的保护，
切换到预算套单价工作薄，这时可以看到工作薄里定额工作表已经显示出来了，
大家可以看到

在02单价V1.3中,网友提出的几个问题,是都可以在这儿解决的.
第一列数据是"定额电算编号",这个数据是我们定额编号,大家怎细看数据的前面多了一位数,这个数据是
用来曲别定额章节的,以它来确定不同的费率,比如:安装工程\建筑工程等。
第二列数据是 "电算编号" ,这个数据是与定额中的电算编号一样,每一种材料\人工\机械都有一个唯一的编号,(它的作用一是,在计算时可以提供判断依据,L表示人\M表示材料\P表示机械, 当然大家也可以加一个其它的字母来代表我们新加的项目。别外一个作用是大家如果是用手工输入定额库的话，可以用,if +VLOOKUP函数写一个东东来简化输入的过程，这样行先建好电算编号，以后就可以只输编号不再用打汉字了。
不过不提倡这种输入定额的方法。另外有一个方法，是利用单位的软件导出电子表格的单价分析表进行加工，虽然不全，但是只要把多选一的部分再加进去。总比一条一条输入速度要快[讲座结束时，再送几个函数]）
第三列数据是 “数量”它是与后面第五列数据是对应的，这个就没什么好说的了。
第四列数据暂且不说
第五列数据是 “项目名称”它是定额里每一项的项目名称，每一项均与每三列相对应。按顺序输入
后面的几列大家一看就知道了。不讲了
下面大家选择条目工作表，第六列至第十列是隐藏的，把这几列用鼠标拉开，可能经看到

位置列共有2个数据：大家看下，1、定额：是指在本程序中工作表的名称，[当大家也可以改成省定额，什么的，但是现在先不要改，]。 2、这第2个数据是本项定额在定额工作表中开始的行号。。
3、项数，是指自第n行开始本条定额一共多少项。
到这里你已经看出定额大致结构了，
其它几列，就不讲了，大家自已看吧，
在02单价中，所指出的错误，就是在这里改的，现在同志们可以试试修改成几条本省的定额，然后再运行一下，是不是有点意思了。
:)
大家不要指望我能讲多细，因为我也是从5.1 才开始学习的，希望大家多交流，
5月9日............................................

大家看下,表头的位置是可以随意改动的,我们可以多做几个模板,分别命名为AHTB.CFB、AHTB1.CFB、AHTB2.CFB等。最简单的方法是在做单价之前把所要用的模板名字改为AHTB.CFB
就可以了。

在这里有一个 CreateResultFile程序
大家看以下一段代码
'释放造价模板文件至临时文件夹,文件名为ahsl.c
Public Sub FreeCostFilePat(rFilePath As String)
Dim temPath As String, str As String, i As Integer
Dim wor As Workbook, flm As String, inputdata As String
Dim myfile As SectionedFile
Dim strTemp As String ' 临时文件夹

'安装后模板文件放置在工作薄同目录下
Select Case gFileModel
Case 1 '投标模板
temPath = GetCurrentPath & "ahtb.cfb" ‘ 根据我们的选择，定义模板文件的名字[另外我们可以在这里再加入一个询问窗口和 IF THNE 语句再增加几个模板。
Case 2 '清单模板
temPath = GetCurrentPath & "ahqd.cfb" '清单模板文件的路径 &清单文件名
End Select
'检查模板文件是否存在
If VBA.Dir(temPath) = "" Then
MsgBox "模板文件不存在或被移动，建议重新安装本软件。", vbOKOnly + vbExclamation, TipCaptionStr
End
End If
If IsFileAlreadyOpen(temPath) Then
MsgBox "创建单价文件错误。模板文件正在使用。", vbOKOnly + vbInformation, TipCaptionStr
End
End If
'获得系统临时文件夹
strTemp = String(100, Chr$(0))
GetTempPath 100, strTemp
strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)
If VBA.Right(strTemp, 1) <> "\" Then strTemp = strTemp & "\"
'检测释放的模板文件是否存在和打开
If VBA.Dir(strTemp & "ahsl.c") <> "" Then
If IsFileAlreadyOpen(strTemp & "ahsl.c") Then
MsgBox "创建单价文件错误。模板文件正在使用。", vbOKOnly + vbInformation, TipCaptionStr
End
Else
Kill strTemp & "ahsl.c"
End If
End If
'释放模板文件到临时文件夹
ReDim myfile.Files(1)
ReDim myfile.Files(1).Bytes(1 To 10)

Open temPath For Binary As #1
flm = strTemp & "ahsl.txt"
Open flm For Binary As #2
'头文件字节数10
Get #1, 1, myfile.Files(1).Bytes
Put #2, 1, myfile.Files(1).Bytes
Close #2
Open flm For Input As #2
Line Input #2, inputdata
If Trim(inputdata) <> "AHSLCostMB" Then ‘AHSLCostMB这几个字是模板文件前10个字符，判断模板文件头10个字节,是否为"AHSLCostMB" ,
MsgBox "模板文件被损坏，建议重新安装本软件。", vbOKOnly + vbExclamation, TipCaptionStr
End
End If
Close #2
Kill flm '删除用于检测的头文件
ReDim myfile.Files(1).Bytes(1 To LOF(1) - 10)
flm = strTemp & "ahsl.c" ' AHSL.C为临时文件 strTemp为临时文件路径.
Open flm For Binary As #2 '打开临时文件 2#通道
'紧接文件头后读出，起始字节为10+1。。。。。。。。。。。。。。。这后面便是我们前面提取到的EXCEL模板文件。。。。。。。。。。。。。
Get #1, 11, myfile.Files(1).Bytes '读模板文件,自11字节开始,也就是去掉AHSLCostMB后的文件
Put #2, 1, myfile.Files(1).Bytes '将读入的数据写入ahsl.c文件.
Close #2 '关闭文件
Close 1# '关闭文件
rFilePath = flm
End Sub

哈哈，你能看明白这段代码吗？。。。。。

大家有什么问题在下面回复吧,

上面讲的应该是本程序的核心内容了,大家接合主程序认真的看才行,要是有什么问题提出来[不要给我发短消息,直接在下面回帖提出来我们一起来解决],短消息概不回复
下面在第十三\十四\十五楼继续讲[今天刚从黄山回来,明天再讲,,大家可以先提问题,我根据问题讲]
13\14\15我先占下呵呵

[ 本帖最后由 m248131854 于 2010-9-27 20:54 编辑 ]

m248131854

2009年05月18日 14:44:53

12楼

14#我占了....

m248131854

2009年05月18日 14:45:27

13楼

15#我占了....

xzyxz

2009年05月18日 21:10:20

14楼

感谢大侠的讲解，有些不明白的地方，请指教：
1、单价分析表如果是表头不同，很容易修改了，但如果单价分析表里面有两、三项不同，如你在讲解的最上面说的山东的单价分析标多了一项其他费用，如何修改，怎么才能反应到代码中去？
2、修改单价分析表的表头或修改里面的局部内容，"分别命名为AHTB.CFB、AHTB1.CFB、AHTB2.CFB"，在代码中如何执行这个工作表？
3、最后列出的这段代码，特别是红字标出的部分，不明白什么意思，请详细介绍下。
4、在主程序中，如果增加本省定额，在代码中如何编写执行程序。
5、原程序中，自定义模板的错误如何修改。
6、按照大侠的思路，修改好的单价分析表如何复制到原程序中去才可以执行。
我是菜鸟，提问不当的地方请谅解。

zkchen2008

2009年05月18日 22:12:39

15楼

楼主真是有本事，偶也学习了哈，只是偶只晓得套哈子定额哈，没有详细分析呢:lol

zdy611

2009年05月22日 22:01:01

16楼

呵...
得来的全部费工夫呀..
好好的图
就这样被偶找到了
要的就是这样的好图啊..
我喜欢
谢谢楼主....
楼主要继续加油啊,.,,
我很期待...

yxz57507

2009年05月24日 08:54:00

17楼

学习中，期待楼主继续讲解。

m248131854

2009年05月24日 18:31:56

18楼

m248131854

2009年05月24日 18:36:37

19楼

最近工作有点忙不好意思；
回答 "1、单价分析表如果是表头不同，很容易修改了，但如果单价分析表里面有两、三项不同，如你在讲解的最上面说的山东的单价分析标多了一项其他费用，如何修改，怎么才能反应到代码中去？
__________________________________________________________________________________________
以山东定额为例，[本人为山东人] 1、修改模板，在模板中机械使用费的下面增加一行，即1.1.4 其它费用并在数量列中建立一个公式：= 人工费+材料费+机械费 [我直接用的汉字，实际做的时要链结好单元格。] 保存好模板。
2、在定额库中为‘其它费用’定义一个电算代号，也就是与其它材料人工有区别的一个特定代号。我这里定义为q9999
3、在代码程序FillinDefData中
'机械
If s1 Like "P????" Or s1 Like "R????" Then
Set rng = .UsedRange.Find(what:="机械使用费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then
rng.Offset(1 + sMach, 0).EntireRow.Insert Shift:=xlDown
Select Case gFileModel
Case 1 '投标
rng.Offset(1 + sMach, -2).Value = s1 '电算编号
rng.Offset(1 + sMach, 0).Value = s6 '名称及规格
rng.Offset(1 + sMach, 1).Value = s5 '单位
rng.Offset(1 + sMach, 2).Value = s2 '数量
sMach = sMach + 1
Case 2 '清单
rng.Offset(1 + sMach, -2).Value = s1 '电算编号
rng.Offset(1 + sMach, 0).Value = s3 '名称
rng.Offset(1 + sMach, 1).Value = s4 '规格
rng.Offset(1 + sMach, 2).Value = s5 '单位
rng.Offset(1 + sMach, 3).Value = s2 '数量
sMach = sMach + 1
End Select
End If
End If”
后面添加以下代码：“ If s1 Like "q????" Then
Set rng = .UsedRange.Find(what:="其它费用", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole) '其它费用写定额????????????????????????????///
If Not rng Is Nothing Then
' rng.Offset(sMate, -2).EntireRow.Insert Shift:=xlDown
Select Case gFileModel

Case 1 '投标
sMate = 1
If gDeNumber > 230017 Then
rng.Offset(sMate - 1, -2).Value = s1 '电算编号
'rng.Offset(sMate - 1, 0).Value = s6 '名称及规格
rng.Offset(sMate - 1, 1).Value = s5 '单位
rng.Offset(sMate - 1, 3).Value = s2 '数量写入单价列
Else
rng.Offset(sMate - 1, -2).Value = s1 '电算编号
' rng.Offset(sMate - 1, 0).Value = s6 '名称及规格
rng.Offset(sMate - 1, 1).Value = s5 '单位
rng.Offset(sMate - 1, 3).Value = s2 '数量写入单价列
End If

Case 2 '清单
rng.Offset(sMate - 1, -2).Value = s1 '电算编号
' rng.Offset(sMate - 1, 0).Value = s6 '名称及规格
rng.Offset(sMate - 1, 2).Value = s5 '单位
rng.Offset(sMate - 1, 3).Value = s2 '数量写入单价列

m248131854

2009年05月24日 18:38:34

20楼

在CalSinglePrice程序中将代码修改为
Public Sub CalSinglePrice()
Dim i As Integer, qu As String, qut As String, quzj As String, qupc As String, adpc As String, adzj As String
Dim 人工ad, 材料ad, 机械ad, 直接ad, 其他ad, 材差ad, 装置ad, 税金ad, 合计ad As String
Dim 施管ad, 利润ad As String
Dim rng As Range, rng1 As Range, rng2 As Range, rng3 As Range
'设置各人、材、机计算公式
With gShdj
Select Case gFileModel
Case 1 '投标
Set rng = .UsedRange.Find(what:="人工费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 人工ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="材料费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 材料ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="机械使用费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 机械ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="其它费用", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 其它费用ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="直接费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole) '其它费用的地址?????????????
If Not rng Is Nothing Then 直接ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="其他直接费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 其他ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="材料价差", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 材差ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="未计价装置性材料费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 装置ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="税金", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 税金ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="合计", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 合计ad = rng.Offset(0, 4).Address
Case 2 '清单
Set rng = .UsedRange.Find(what:="人工费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 人工ad = rng.Offset(0, 5).Address
Set rng = .UsedRange.Find(what:="材料费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 材料ad = rng.Offset(0, 5).Address
Set rng = .UsedRange.Find(what:="机械使用费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 机械ad = rng.Offset(0, 5).Address
Set rng = .UsedRange.Find(what:="其它费用", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole) '其它费用的地址?????????????
If Not rng Is Nothing Then 其它费用ad = rng.Offset(0, 4).Address
Set rng = .UsedRange.Find(what:="直接费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 直接ad = rng.Offset(0, 5).Address
Set rng = .UsedRange.Find(what:="施工管理费", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 施管ad = rng.Offset(0, 5).Address
Set rng = .UsedRange.Find(what:="企业利润", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 利润ad = rng.Offset(0, 5).Address
Set rng = .UsedRange.Find(what:="税金", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 税金ad = rng.Offset(0, 5).Address
Set rng = .UsedRange.Find(what:="合计", After:=Range(sTabPos), LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then 合计ad = rng.Offset(0, 5).Address
End Select

End With

For j = 1 To Range(合计ad).Row - Range(人工ad).Offset(1, 0).Row
Range(人工ad).Offset(j, 0).FormulaR1C1 = "=ROUND(RC[-2]*RC[-1]," & gJindu & ")"
Next

'人工费
If Range(人工ad).Offset(1).Row <= Range(材料ad).Offset(-1).Row Then
qu = Range(人工ad).Offset(1).Address & ":" & Range(材料ad).Offset(-1).Address
Range(人工ad).Formula = "=sum(" & qu & ")"
Else
Range(人工ad).Value = Empty
End If

'材料费
If Range(材料ad).Offset(1).Row <= Range(机械ad).Offset(-1).Row Then
qu = Range(材料ad).Offset(1).Address & ":" & Range(机械ad).Offset(-1).Address
Range(材料ad).Formula = "=sum(" & qu & ")"
Else
Range(材料ad).Value = Empty
End If

m248131854

2009年05月24日 18:39:07

21楼

'机械费
qu = ""
Select Case gFileModel
Case 1 '投标
For i = Range(机械ad).Row + 1 To Range(其他ad).Row - 1
If Cells(i, Range(机械ad).Column - 6).Value Like "P*" Then
qu = qu & "," & Cells(i, Range(机械ad).Column).Address
If Cells(i, Range(机械ad).Column - 6).Value Like "P9054" Then
adzj = Cells(i, Range(机械ad).Column).Address
Else
'主要机械，计算其他机械的基数
quzj = quzj & "," & Cells(i, Range(机械ad).Column).Address
End If
ElseIf Cells(i, Range(机械ad).Column - 6).Value Like "R*" Then
'嵌套项累计
qut = qut & "," & Cells(i, Range(机械ad).Column).Address
End If
Next i
Case 2 '清单
For i = Range(机械ad).Row + 1 To Range(施管ad).Row - 1
If Cells(i, Range(机械ad).Column - 7).Value Like "P*" Then
qu = qu & "," & Cells(i, Range(机械ad).Column).Address
If Cells(i, Range(机械ad).Column - 7).Value Like "P9912" Then
adzj = Cells(i, Range(机械ad).Column).Address
Else
'主要机械，计算其他机械的基数
quzj = quzj & "," & Cells(i, Range(机械ad).Column).Address
End If
ElseIf Cells(i, Range(机械ad).Column - 7).Value Like "R*" Then
'嵌套项累计
qut = qut & "," & Cells(i, Range(机械ad).Column).Address
End If
Next i
End Select
If qu <> "" Then
qu = VBA.Mid(qu, 2)
qu = qu + qut
Range(机械ad).Formula = "=sum(" & qu & ")"
Else
Range(机械ad).Value = Empty
End If

'直接费
' Select Case gFileModel
' Case 1 '投标
' qu = Range(人工ad).Address + "," + Range(材料ad).Address + "," + Range(机械ad).Address + qut
' Case 2 '清单
qu = Range(人工ad).Address + "," + Range(材料ad).Address + "," + Range(机械ad).Address + "," + Range(其它费用ad).Address
' End Select
Range(直接ad).Formula = "=sum(" & qu & ")"

'材差
If (gDeferStyle = 2 Or gDeferStyle = 3) And gFileModel = 1 Then
If gAdjustPrice = 1 Then
If Range(材差ad).Offset(1).Row <= Range(税金ad).Offset(-1).Row Then
qu = Range(材差ad).Offset(1).Address & ":" & Range(税金ad).Offset(-1).Address
Range(材差ad).Formula = "=sum(" & qu & ")"
Else
Range(材差ad).Value = Empty
End If
End If
End If

'装置性材料费
If (gDeferStyle = 2 Or gDeferStyle = 4) And gFileModel = 1 Then
If Range(装置ad).Offset(1).Row <= Range(税金ad).Offset(-1).Row Then
qu = Range(装置ad).Offset(1).Address & ":" & Range(税金ad).Offset(-1).Address
Range(装置ad).Formula = "=ROUND(sum(" & qu & "),2)"
Else
Range(装置ad).Value = Empty
End If
End If

'计算零星材料费、其他材料费
For i = Range(材料ad).Row + 1 To Range(机械ad).Row - 1
If Cells(i, Range(材料ad).Column - 5 - gFileModel).Value Like "M9907" Then
'计算零星材料费
Cells(i, Range(材料ad).Column - 1).Formula = "=sum(" + 人工ad + "," + 机械ad + ")"
Cells(i, Range(材料ad).Column).FormulaR1C1 = "=ROUND(RC[-2]*RC[-1]/100," & gJindu & ")"
ElseIf Cells(i, Range(材料ad).Column - 5 - gFileModel).Value Like "M9999" Then
'其他材料的单元格地址
adpc = Cells(i, Range(材料ad).Column).Address
Else
'主材，计算其他材料费的基数
qupc = qupc & "," & Cells(i, Range(材料ad).Column).Address
End If
Next i
'其他材料费
If qupc <> "" And adpc <> "" Then
qupc = VBA.Mid(qupc, 2)
Range(adpc).Offset(0, -1).Formula = "=sum(" + qupc + ")"
Range(adpc).FormulaR1C1 = "=ROUND(RC[-2]*RC[-1]/100," & gJindu & ")"
End If
'其他机械费
If quzj <> "" And adzj <> "" Then
quzj = Mid(quzj, 2)
Range(adzj).Offset(0, -1).Formula = "=sum(" + quzj + ")"
Range(adzj).FormulaR1C1 = "=ROUND(RC[-2]*RC[-1]/100," & gJindu & ")"
End If
'清单单价公式
If gFileModel = 2 Then
Range(合计ad).Formula = "=sum(" + 直接ad + "," + 施管ad + "," + 利润ad + "," + 税金ad + ")"
If gDeferStyle = 1 Or gDeferStyle = 3 Then
Range(施管ad).Offset(0, -2).Formula = "=" & 直接ad
Else
Range(施管ad).Offset(0, -2).Formula = "=" & 人工ad
End If
Range(利润ad).Offset(0, -2).Formula = "=sum(" + 直接ad + "," + 施管ad + ")"
Range(税金ad).Offset(0, -2).Formula = "=sum(" + 直接ad + "," + 施管ad + "," + 利润ad + ")"
End If

'计算结束,多选一复0
gChoose = ""
gDelItem = ""
Range(sTabPos).Select
End Sub
End Select
End If
End If
——————————————————————————————————————————————————————————————————————————
今天先讲这儿，待回答完问题再讲

这几天比较忙，不好意思:)