“”钢结构表格设计窗体“”-实现输入数据到多工作表中，提前谢谢各位大师

lele400024 · 发表于 2016-7-17 19:15

在此，提前谢谢各位解答的朋友和查看本帖的朋友现有计算钢结构的几张工作表，现在想设计一个窗体，输入完信息后，根据类别，把数据输入到对应工作表中去。1.附件如下：

设计窗体.rar (151.48 KB, 下载次数: 28)

2.数据结构如下：

数据结构1.png

3.实现效果如下：

实现效果.png

再次表示感谢了

cbtaja · 发表于 2016-7-18 09:02

各种型材和板材的单重、表面积等参数，这些可以从五金手册中查得的数据，不宜在表格中重复计算，既费力又容易出错。即使是从五金手册中不能直接查得的非标的H型钢，也应另外编算这些基本参数，然后在工程量计算表中直接引用，这样表格才能既简洁、又清晰。

看看用我的《工程量计算表》模板做出来的效果吧（表格中的五金数据是随手模拟的）。
我的这个模板，可以通用于土建、水电、装饰、园林等各类工程量计算：

钢结构工程量计算表.rar (124.56 KB, 下载次数: 107)

lele400024 · 发表于 2016-7-18 09:03

有没有人帮忙指点一下啊

lele400024 · 发表于 2016-7-18 14:06

cbtaja 发表于 2016-7-18 09:02
各种型材和板材的单重、表面积等参数，这些可以从五金手册中查得的数据，不宜在表格中重复计算，既费力又容 ...

谢谢你的答复，我测试了，很强大，向你学习。看了代码，不是现在我能力范围可修改的，注释自动显示下标和计算表达式的值，对我而言很有用，能否单独提出代码，稍微解释一下，谢谢

cbtaja · 发表于 2016-7-18 14:19

lele400024 发表于 2016-7-18 14:06
谢谢你的答复，我测试了，很强大，向你学习。看了代码，不是现在我能力范围可修改的，注释自动显示下标和 ...

你原来表格中就有计算表达式的值的函数mc，我可以帮你把“注释自动下标”的功能加进去。

lele400024 · 发表于 2016-7-18 14:27

cbtaja 发表于 2016-7-18 14:19
你原来表格中就有计算表达式的值的函数mc，我可以帮你把“注释自动下标”的功能加进去。

好的，谢谢，麻烦帮我再添加一下不用输入[]也可以计算，就好了，每次都要输[]，很麻烦

cbtaja · 发表于 2016-7-18 14:43

lele400024 发表于 2016-7-18 14:06
谢谢你的答复，我测试了，很强大，向你学习。看了代码，不是现在我能力范围可修改的，注释自动显示下标和 ...

把你原表格中的模块1中的自定义函数MC代码整个替换成如下，然后在包含有MC函数的单元格中按一下F2然后回车，就自动把所有的注释都下标了：

Function MC(ByVal Rng As Range)
Dim exp$, reg, matches, ma
Set reg = CreateObject("VBSCRIPT.REGEXP")
reg.Global = True
reg.Pattern = "\[.*?\]|{(.*?)}|[^0-9.+-/^*()]"
exp = Rng.Cells(1).Value
Set matches = reg.Execute(exp)
With Rng.Cells(1).Font
.Superscript = False
.Subscript = False
.ColorIndex = 0
End With
For Each ma In matches
With Rng.Cells(1).Characters(1 + ma.firstindex, ma.Length).Font
.Subscript = True
.Color = vbBlue
End With
Next
MC = Evaluate(reg.Replace(exp, ""))
End Function

复制代码

lele400024 · 发表于 2016-7-18 14:54

cbtaja 发表于 2016-7-18 14:43
把你原表格中的模块1中的自定义函数MC代码整个替换成如下，然后在包含有MC函数的单元格中按一下F2然后回 ...

谢谢你的答复，已经可以不用[]可以计算了，但是下标还是不行，只是变成蓝色，但是不是下标，详细请见图
下标.png

cbtaja · 发表于 2016-7-18 16:51

在 ThisWorkbook 模块下，粘贴以下代码，可以让你在全新输入或修改一个计算式后，立即使其中的注释内容自动下标：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim exp$, i&, matches, ma, i&
If Sh.Name = "图纸名称" Then Exit Sub
For i = 1 To 3
If InStr(Sh.Cells(i, Target.Column), "计算式") Then
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.Pattern = "\[.*?\]|{(.*?)}|[^0-9.+-/^*()]"
exp = Target.Cells(1).Value
With Target.Cells(1).Font
.Superscript = False
.Subscript = False
.ColorIndex = 0
End With
Set matches = reg.Execute(exp)
For Each ma In matches
With Target.Cells(1).Characters(1 + ma.firstindex, ma.Length).Font
.Subscript = True
.Color = vbBlue
End With
Next
Exit For
End If
Next
End Sub

复制代码

cbtaja · 发表于 2016-7-18 16:54

在模块1 添加以下宏，运行它可以在整个工作薄中搜索“计算式”所在的列，并把其计算式中的注释内容下标

Sub 注释批量下标()
Dim exp$, i&, matches, ma, Sh As Worksheet, Target As Range
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.Pattern = "\[.*?\]|{(.*?)}|[^0-9.+-/^*()]"
For Each Sh In Sheets
For c = 1 To Sh.UsedRange.Columns.Count
For i = 1 To 3
If InStr(Sh.Cells(i, c), "计算式") Then
For j = i + 1 To Sh.UsedRange.Rows.Count
exp = Sh.Cells(j, c).Value
Set matches = reg.Execute(exp)
With Sh.Cells(j, c).Font
.Superscript = False
.Subscript = False
.ColorIndex = 0
End With
For Each ma In matches
With Sh.Cells(j, c).Characters(1 + ma.firstindex, ma.Length).Font
.Subscript = True
.Color = vbBlue
End With
Next
Next
Exit For
End If
Next
Next
Next
End Sub

复制代码

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

[求助] “”钢结构表格设计窗体“”-实现输入数据到多工作表中，提前谢谢各位大师

评分

评分