[已解决]查找并动态增减行及汇总

grf1973 · 发表于 2017-9-1 14:23

请看附件。按要求设置了一下。

lidayu · 发表于 2017-9-1 15:06

grf1973 发表于 2017-9-1 14:23
请看附件。按要求设置了一下。

grf1973老师您好，调试后完美实现了要求，你写的代码太深奥了，我刚才试着放到格式不一样的工作簿，老是出现错误，您能否帮我在代码注释下，深表感谢！

grf1973 · 发表于 2017-9-1 15:21

加了，慢慢理解。

lidayu · 发表于 2017-9-1 16:28

grf1973 发表于 2017-9-1 15:21
加了，慢慢理解。

grf1973 老师您好，您不厌其烦的赐教令学生感激不尽，谢谢您！

lidayu · 发表于 2017-9-1 18:54

grf1973 发表于 2017-9-1 15:21
加了，慢慢理解。

grf1973老师您好，我把代码用在其它工作簿上出现了错误，烦请您再帮我看看代码哪被我弄错了，谢谢！
符上图片及代码供你核对

Sub 姓名号型汇总()
arr = Sheets("数据源").[a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 5)
ddw = [b2]: xdw = [b3] '大单位、小单位
For i = 2 To UBound(arr)
If arr(i, 2) = ddw And (arr(i, 3) = xdw Or xdw = "") Then '找到符合条件的记录，形成数组Brr
n = n + 1
brr(n, 1) = arr(i, 5) '姓名
brr(n, 2) = arr(i, 7) '号型
hx = Val(arr(i, 1)) '品种名称
If hx = 0 Then hx = 2
brr(n, hx + 2) = arr(i, 6) '数量(根据号型填到相应的列中去，如果没有号型，填到第7列）
brr(n, 5) = arr(i, 6)
End If
Next
Range("a6:e1000").Clear '清空显示区域
[a6].Resize(n, 5) = brr '显示内容
[a6].Resize(n, 5).Sort key1:=[a6], key2:=[b6] '按名字和品种名称排序
r = 6 + n '合计行
Cells(r, 1) = "合计"
Cells(r, 3).Resize(, 2).Formula = "=sum(r3c:r[-1]c)" '合计行的公式
Cells(r, 3).Resize(, 2) = Cells(r, 3).Resize(, 2).Value '把公式转成数值
For j = 3 To 4 '去掉0值
If Cells(r, j) = 0 Then Cells(r, j) = "" '去掉0值
Next
Cells(r + 1, 1) = "总合计"
Cells(r + 1, 2).Resize(1, 4).Merge '总合计行合并单元格
Cells(r + 1, 2) = Application.Sum(Cells(r, 3).Resize(, 2)) '总合计行计算结果
Cells(r + 1, 2).HorizontalAlignment = xlCenter '总合计行合并单元格后居中
Cells(r, 1).Resize(2, 5).Font.Bold = True '合计行和总合计行加粗显示
[E6].Resize(n + 2).Font.Bold = True 'H列加粗显示
[a6].Resize(n + 2, 5).Borders.LineStyle = 1 '加上表格线
For i = r - 1 To 4 Step -1 '第一列姓名（已排序）去掉相同名字
If Cells(i, 1) = Cells(i - 1, 1) Then Cells(i, 1) = ""
Next
End Sub

复制代码

grf1973 · 发表于 2017-9-1 20:31

问题出在 hx = Val(arr(i, 1)) '品种名称上。原来的例子里号型是1号 2号 3号。。。，可以用val来取得数值，现在的号型全是中文，val值就是0，达不到分列的效果。

grf1973 · 发表于 2017-9-1 20:35

可以用 hx = iif(arr(i, 1) like "男*",3,4)
然后 brr(n,hx)=arr(i,6)就行了。

lidayu · 发表于 2017-9-1 20:55

grf1973 发表于 2017-9-1 20:35
可以用 hx = iif(arr(i, 1) like "男*",3,4)
然后 brr(n,hx)=arr(i,6)就行了。

grf1973老师您好，可以了，高手就是高手，能者不难，难者不会。有没有那一种不受数据类型限制通用的。

lidayu · 发表于 2017-9-1 23:21

grf1973 发表于 2017-9-1 20:35
可以用 hx = iif(arr(i, 1) like "男*",3,4)
然后 brr(n,hx)=arr(i,6)就行了。

grf1973 老师您好，您不厌其烦的帮助，我碰到不能解决的问题，都有些不好意思再请您赐教，好人好报，一生平安。问题是想把结果表A列重复数据去除，每个品种名称只保留一个，详见图片并附上代码：

Sub 小单位汇总()
arr = Sheets("数据源").[a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 7)
ddw = [b2]: xdw = [b3] '大单位、小单位
For i = 2 To UBound(arr)
If arr(i, 2) = ddw And (arr(i, 3) = xdw Or xdw = "") Then '找到符合条件的记录，形成数组Brr
n = n + 1
' brr(n, 1) = arr(i, 4) '姓名
brr(n, 1) = arr(i, 1) '品种名称
hx = Val(arr(i, 6)) '号型
If hx = 0 Then hx = 5
brr(n, hx + 1) = arr(i, 5) '数量(根据号型填到相应的列中去，如果没有号型，填到第7列）
brr(n, 7) = arr(i, 5)
End If
Next
Range("a6:g1000").Clear '清空显示区域
[a6].Resize(n, 7) = brr '显示内容
[a6].Resize(n, 7).Sort key1:=[a6] ', key2:=[b6] '按名字和品种名称排序
r = 6 + n '合计行
Cells(r, 1) = "合计"
Cells(r, 2).Resize(, 5).Formula = "=sum(r6c:r[-1]c)" '合计行的公式
Cells(r, 2).Resize(, 5) = Cells(r, 2).Resize(, 5).Value '把公式转成数值
For j = 2 To 6 '去掉0值
If Cells(r, j) = 0 Then Cells(r, j) = "" '去掉0值
Next
Cells(r + 1, 1) = "总合计"
Cells(r + 1, 2).Resize(1, 6).Merge '总合计行合并单元格
Cells(r + 1, 2) = Application.Sum(Cells(r, 2).Resize(, 5)) '总合计行计算结果
Cells(r + 1, 2).HorizontalAlignment = xlCenter '总合计行合并单元格后居中
Cells(r, 1).Resize(2, 7).Font.Bold = True '合计行和总合计行加粗显示
[g6].Resize(n + 2).Font.Bold = True 'H列加粗显示
[a6].Resize(n + 2, 7).Borders.LineStyle = 1 '加上表格线
' For i = r - 1 To 6 Step -1 '第一列姓名（已排序）去掉相同名字
' If Cells(i, 1) = Cells(i - 1, 1) Then Cells(i, 1) = ""
' Next
End Sub

复制代码

lidayu · 发表于 2017-9-2 19:27

grf1973 发表于 2017-9-1 20:35
可以用 hx = iif(arr(i, 1) like "男*",3,4)
然后 brr(n,hx)=arr(i,6)就行了。

grf1973老师您好，49楼的要求能不能再帮我实现，如果用改的麻烦，可以用字典重写，只要效果一样就行。谢谢！

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

[已解决]查找并动态增减行及汇总

评分

评分

评分

评分