一个通用的EXCEL工程量计算表

472254304

cbtaja 发表于 2017-1-9 15:52
这就是核心的代码。
它只是一个函数，所以还需要在其它Sub过程中引用，并且提供一个（或一列连续的）单元 ...

好深奥啊，有不有简单的方法就可以实现，[]和里面的文字，变颜色

cbtaja

472254304 发表于 2017-1-9 18:35
好深奥啊，有不有简单的方法就可以实现，[]和里面的文字，变颜色

既然这样，我做一个简单的实例。你只需按实际情况修改Sheet1的VBA代码中的3个参数的预设值就可以用了。 计算式自动求值并突出注释内容.rar (19.84 KB, 下载次数: 340)

2017-1-17 12:26 上传

点击文件名下载附件

472254304

cbtaja 发表于 2017-1-17 02:54
既然这样，我做一个简单的实例。你只需按实际情况修改Sheet1的VBA代码中的3个参数的预设值就可以用了。

老师还有2个问题，就是输入1/1就变成日期了。       二就是可以把等于号也显示出来不，就想图片的一样

472254304

老师我把我的计算稿发给你吧               

cbtaja

472254304 发表于 2017-1-17 12:45
老师还有2个问题，就是输入1/1就变成日期了。       二就是可以把等于号也显示出来不，就想图片的一样

1、关于变成日期的问题：
    计算式列本身不应计算，所以应整列设置为文本格式。就不会出现自动转成日期了。
2、等号显示不出来的问题：
    单元格设置数字自定义格式，会与单元格内 局部设置字体格式（下标、颜色等）相冲突。这两者不可以同时起效。不建议显示"＝"号，因为表格的标题行中明确表示了各列数据的意义。
3、你在44楼提供的模板中，输入[]、()，需要从键盘切换鼠标去点按钮，效率没有什么提高。改成在窗体文本框中输入，可自动配对小括号、中括号，无需来回切换。还有其它诸多改善，见附件： 计算表新.rar (37.95 KB, 下载次数: 115)

2017-1-18 23:19 上传

点击文件名下载附件

472254304

cbtaja 发表于 2017-1-18 20:53
1、关于变成日期的问题：
    计算式列本身不应计算，所以应整列设置为文本格式。就不会出现自动转成日 ...

老师你改的计算稿确实很高级，我实在是驾驭不了，插入几列就不会改了，我对VBA一窍不通，谢谢老师了，老师你那个打括号的确实不错，有没简单的代码就可以实现的，老师你也是做造价的吗

cbtaja

472254304 发表于 2017-1-19 22:00
老师你改的计算稿确实很高级，我实在是驾驭不了，插入几列就不会改了，我对VBA一窍不通，谢谢老师了，老 ...

“有没简单的代码”，这个我不知道。
但我知道旧石器工具制作起来最简单，但更加复杂的铁器工具用起来更加方便。
所以，下面我新给出的这个文档的代码反而更多了那么一.. .. 计算表新.rar (36.61 KB, 下载次数: 100)

2017-1-21 11:11 上传

点击文件名下载附件

ddyy004

cbtaja 发表于 2017-1-21 11:11
“有没简单的代码”，这个我不知道。
但我知道旧石器工具制作起来最简单，但更加复杂的铁器工具用起来更 ...

本人新手，插入两列汇总后不合并相同的项目名称了，求解

cbtaja

ddyy004 发表于 2017-2-3 16:56
本人新手，插入两列汇总后不合并相同的项目名称了，求解

Sub 汇总()
Dim r&, arr, brr, dic, tmp$, i&, p&, n&, quantity#, weight#, tt#
Dim Cel As Range, EEvents As Boolean
Application.ScreenUpdating = False
r = Sheet1.Cells(Rows.Count, 5).End(xlUp).Row
Sheet1.Range("D5") = "=IF(C5="""",IF(B5="""","""",B5&""-""&C5),B5&""-""&C5)"
Sheet1.Range("D5").Copy Sheet1.Range("D5:D" & r)
If r <= 标题行行数 Then Exit Sub
If MsgBox("是否对计算式强制重算结果？", vbYesNo) = vbYes Then
    tt = Timer
    EEvents = Application.EnableEvents
    Application.EnableEvents = False
    On Error Resume Next
    For Each Cel In Sheet1.Cells(标题行行数 + 1, 计算式).Resize(r - 标题行行数)
        tmp = ExpClean(Cel)
        Cel.Offset(, 结果 - 计算式) = tmp
        If Err.Number Then
            Err.Clear
            Cel.Offset(, 结果 - 计算式).Value = "'" & Cel.Offset(, 结果 - 计算式)
        End If
    Next
    Application.EnableEvents = EEvents
Else
    tt = Timer
End If
Set dic = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("A1").Resize(r, 表格总列数)
ReDim brr(0 To r + 1, 1 To 6)
brr(0, 1) = "序号"
brr(0, 2) = "项目名称"
brr(0, 3) = "单位"
brr(0, 4) = "数量"
brr(0, 5) = "理论重量"
brr(0, 6) = "重量t"

For i = 标题行行数 + 1 To r
    If Len(arr(i, 计算式)) Then
        If dic.exists(arr(i, 项目名称)) Then
            p = dic(arr(i, 项目名称))
            brr(p, 4) = brr(p, 4) + arr(i, 结果)
            brr(p, 6) = brr(p, 6) + arr(i, 重量)
        Else
            n = n + 1
            dic(arr(i, 项目名称)) = n
            brr(n, 1) = n
            brr(n, 2) = arr(i, 项目名称)
            brr(n, 3) = arr(i, 单位)
            brr(n, 4) = arr(i, 结果)
            brr(n, 5) = arr(i, 理论重量)
            brr(n, 6) = arr(i, 重量)
        End If
        quantity = quantity + arr(i, 结果)
        weight = weight + arr(i, 重量)
    End If
Next
n = n + 1
brr(n, 1) = "合计"
brr(n, 4) = quantity
brr(n, 6) = weight
With Sheet2.Range("A1").Resize(n + 1, 6)
    .EntireColumn.Clear
    .Value = brr
    .Borders.LineStyle = 1
    .Columns(4).NumberFormat = "0.000_ "
    .Columns(6).NumberFormat = "0.000_ "
    .Columns(1).HorizontalAlignment = xlCenter
    .Columns(3).HorizontalAlignment = xlCenter
    .Resize(1).HorizontalAlignment = xlCenter
    .Resize(1).Font.Bold = True
    .EntireColumn.AutoFit
    MsgBox Format(Timer - tt, "汇总完成，用时0.00秒！")
    .Parent.Select
End With
End Sub

737077

25楼的文件显示变量未定义。。没办法用