Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3231|回复: 5

[已解决](若干行,若干列)条件循环运算+插入行列输出结果

[复制链接]
发表于 2015-3-30 23:12 | 显示全部楼层 |阅读模式
有原始数据若干行,若干列如下:
地区苹果梨子葡萄干巴旦木榴莲干牡蛎虾仁豆腐干牛肉干马肉干
北京28321432113232271313
山东32111547274747641818
广西47271366646666113131
河北66641812111212183232
大连12113119181919144747
合肥19183213143232156666
石家庄92144718154747131212
开源31156631196666181919
高州84131232131212311111
江西97181947181919131212
陆平65311166171418181919
           
每隔两列和隔3列就需插入一行并进行运算,运算公式如表中注释,并在表的结尾含插入一行输入合计,计算公式如标注,最终效果如下:
地区苹果梨子苹果比例葡萄干巴旦木榴莲干葡萄干比例牡蛎虾仁牡蛎比例豆腐干牛肉干马肉干豆腐干比例
北京2832’=B2/B2+C2143211‘=E2/E2+F2+G23232’=I2/I2+J2271313=L2+L2+M2+N2
山东32110.7441860471547270.16853932647470.56418180.64
广西47270.6351351351366640.09090909166660.51131310.150684932
河北66640.5076923081812110.4390243912120.51832320.219512195
大连12110.521739133119180.45588235319190.51447470.12962963
合肥19180.5135135143213140.54237288132320.51566660.102040816
石家庄92140.8679245284718150.587547470.51312120.351351351
开源31150.6739130436631190.56896551766660.51819190.321428571
高州84130.8659793811232130.21052631612120.53111110.58490566
江西97180.8434782611947180.22619047619190.51312120.351351351
陆平65310.6770833331166170.11702127714180.43751819190.321428571
  合计‘=sum(B列)/Sum(B:C列)  合计‘=sum(E列)/Sum(E:G列) 合计‘=sum(I列)/Sum(I:J列)  合计‘=sum(L列)/Sum(L:N列)
数据有若干行,若干列,但运算格式一定,求VBA实现
最佳答案
2015-3-31 13:14
加了说明,去掉废句。
  1. Sub tt()
  2.     arr = Array("", "豆腐干", "牡蛎", "葡萄干", "苹果")
  3.     With ActiveSheet
  4.         For i = 0 To 3      '插入列,并填入表头
  5.             c = IIf(i = 0, 12, .Rows(1).Find(arr(i)).Column)
  6.             .Columns(c).Insert
  7.             .Cells(1, c) = arr(i + 1) & "比例"
  8.         Next
  9.         .[a65536].End(3).Offset(1) = "合计"
  10.         brr = .[a1].CurrentRegion
  11.         For j = 4 To 1 Step -1        '找到计算比例的列
  12.             s1 = 0        '待计算品种求和
  13.             s2 = 0        '所有品种求和
  14.             If j = 4 Then c1 = 2        '待计算品种的起始列
  15.             c2 = .Rows(1).Find(arr(j) & "比例").Column - 1  '找到计算比例的列
  16.             For i = 2 To UBound(brr) - 1
  17.                 s = 0      '本行所有品种求和
  18.                 s1 = s1 + brr(i, c1)        '待计算品种求和
  19.                 For k = c1 To c2     '开始列--结束列累加
  20.                     s = s + brr(i, k)       '本行所有品种求和
  21.                     s2 = s2 + brr(i, k)      '所有品种求和
  22.                 Next
  23.                 If s > 0 Then brr(i, c2 + 1) = brr(i, c1) / s       '计算比例
  24.             Next
  25.             If s2 > 0 Then brr(i, c2 + 1) = s1 / s2      '计算合计比例
  26.             c1 = c2 + 2       '下一种品种的起始列
  27.         Next
  28.         .[a1].CurrentRegion = brr
  29.         .[a1].CurrentRegion.Columns.AutoFit
  30.         .[a1].CurrentRegion.Borders.LineStyle = 1
  31.     End With
  32. End Sub
复制代码

求助.rar

10.28 KB, 下载次数: 13

发表于 2015-3-31 10:55 | 显示全部楼层
本帖最后由 雪舞子 于 2015-3-31 15:22 编辑

固定插入 D/H/K/O 列吗?

如果固定插入这几列,手工操作可能比VBA还要快,

而且函数公式也比较简单,干嘛非要用VBA呢?

代码附下:
  1. Sub test()
  2.     Dim i%, j%, k%, n, m, ar, rng As Range
  3.     ar = Array(Array(12, -2), Array(9, -1), Array(7, -2), Array(4, -1))
  4.     For i = 0 To 3
  5.         Columns(ar(i)(0)).Ins_ert 'Insert,去掉中间的短横线
  6.         Cells(1, ar(i)(0)) = Cells(1, ar(i)(0))(1, ar(i)(1)) & "比例"
  7.         n = 0: m = 0
  8.         For j = 2 To 12
  9.             Set rng = Cells(j, ar(i)(0))
  10.             For k = ar(i)(1) To 0
  11.                 rng = rng + rng(1, k)
  12.             Next
  13.             m = m + rng
  14.             n = n + Cells(j, ar(i)(0))(1, ar(i)(1))
  15.             rng = Cells(j, ar(i)(0))(1, ar(i)(1)) / rng
  16.         Next
  17.         rng(2, 1) = n / m
  18.         rng(2, 0) = "合计"
  19.     Next
  20. End Sub
复制代码
回复

使用道具 举报

发表于 2015-3-31 13:04 | 显示全部楼层
  1. Sub lqxs()
  2. Dim Arr, i&, c, Brr, col%, ks, js, x&, j&, aa, bb, c1, ks1, m&
  3. Sheet1.Activate
  4. c = Array(2, 3, 2, 3)
  5. Arr = [a1].CurrentRegion
  6. ReDim Brr(1 To UBound(Arr) + 1, 1 To UBound(Arr, 2) + UBound(c) + 1)
  7. For i = 1 To UBound(Arr)
  8.     Brr(i, 1) = Arr(i, 1)
  9. Next
  10. For i = 0 To UBound(c)
  11.     If i = 0 Then
  12.         ks = 2: ks1 = 2
  13.     Else
  14.         ks = ks + c(i - 1): ks1 = js + i
  15.     End If
  16.     js = ks + c(i): aa = 0: bb = 0: m = 0
  17.     For j = ks To js - 1
  18.         Brr(1, ks1 + m) = Arr(1, j)
  19.         For x = 2 To UBound(Arr)
  20.             Brr(x, ks1 + m) = Arr(x, j)
  21.             If j = ks Then aa = aa + Arr(x, j)
  22.             bb = bb + Arr(x, j)
  23.         Next
  24.         m = m + 1
  25.     Next
  26.     For x = 2 To UBound(Brr) - 1
  27.         c1 = 0
  28.         For j = ks To js - 1
  29.             c1 = c1 + Arr(x, j)
  30.         Next
  31.         Brr(x, ks1 + m) = Arr(x, ks) / c1
  32.     Next
  33.     Brr(1, ks1 + m) = Arr(1, ks) & "比例"
  34.     Brr(UBound(Arr) + 1, ks1 + m - 1) = "合计"
  35.     Brr(UBound(Arr) + 1, ks1 + m) = aa / bb
  36. Next
  37. [a20].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
  38. [a20].Resize(UBound(Brr), UBound(Brr, 2)).Borders.LineStyle = 1
  39. End Sub
复制代码

求助0331.rar

21.52 KB, 下载次数: 7

回复

使用道具 举报

发表于 2015-3-31 13:09 | 显示全部楼层
  1. Sub tt()
  2.     arr = Array("", "豆腐干", "牡蛎", "葡萄干", "苹果")
  3.     With ActiveSheet
  4.         For i = 0 To 3
  5.             c = IIf(i = 0, 12, .Rows(1).Find(arr(i)).Column)
  6.             xc = xc & "," & c
  7.             .Columns(c).Insert
  8.             .Cells(1, c) = arr(i + 1) & "比例"
  9.         Next
  10.         .[a65536].End(3).Offset(1) = "合计"
  11.         brr = .[a1].CurrentRegion
  12.         xrr = Split(xc, ",")
  13.         For j = 4 To 1 Step -1
  14.             s1 = 0: s2 = 0
  15.             If j = 4 Then c1 = 2
  16.             c2 = .Rows(1).Find(arr(j) & "比例").Column - 1
  17.             For i = 2 To UBound(brr) - 1
  18.                 s = 0
  19.                 s1 = s1 + brr(i, c1)
  20.                 For k = c1 To c2
  21.                     s = s + brr(i, k)
  22.                     s2 = s2 + brr(i, k)
  23.                 Next
  24.                 If s > 0 Then brr(i, c2 + 1) = brr(i, c1) / s
  25.             Next
  26.             brr(i, c2 + 1) = s1 / s2
  27.             c1 = c2 + 2
  28.         Next
  29.         .[a1].CurrentRegion = brr
  30.         .[a1].CurrentRegion.Columns.AutoFit
  31.         .[a1].CurrentRegion.Borders.LineStyle = 1
  32.     End With
  33. End Sub
复制代码

求助.rar

22.68 KB, 下载次数: 5

回复

使用道具 举报

发表于 2015-3-31 13:14 | 显示全部楼层    本楼为最佳答案   
加了说明,去掉废句。
  1. Sub tt()
  2.     arr = Array("", "豆腐干", "牡蛎", "葡萄干", "苹果")
  3.     With ActiveSheet
  4.         For i = 0 To 3      '插入列,并填入表头
  5.             c = IIf(i = 0, 12, .Rows(1).Find(arr(i)).Column)
  6.             .Columns(c).Insert
  7.             .Cells(1, c) = arr(i + 1) & "比例"
  8.         Next
  9.         .[a65536].End(3).Offset(1) = "合计"
  10.         brr = .[a1].CurrentRegion
  11.         For j = 4 To 1 Step -1        '找到计算比例的列
  12.             s1 = 0        '待计算品种求和
  13.             s2 = 0        '所有品种求和
  14.             If j = 4 Then c1 = 2        '待计算品种的起始列
  15.             c2 = .Rows(1).Find(arr(j) & "比例").Column - 1  '找到计算比例的列
  16.             For i = 2 To UBound(brr) - 1
  17.                 s = 0      '本行所有品种求和
  18.                 s1 = s1 + brr(i, c1)        '待计算品种求和
  19.                 For k = c1 To c2     '开始列--结束列累加
  20.                     s = s + brr(i, k)       '本行所有品种求和
  21.                     s2 = s2 + brr(i, k)      '所有品种求和
  22.                 Next
  23.                 If s > 0 Then brr(i, c2 + 1) = brr(i, c1) / s       '计算比例
  24.             Next
  25.             If s2 > 0 Then brr(i, c2 + 1) = s1 / s2      '计算合计比例
  26.             c1 = c2 + 2       '下一种品种的起始列
  27.         Next
  28.         .[a1].CurrentRegion = brr
  29.         .[a1].CurrentRegion.Columns.AutoFit
  30.         .[a1].CurrentRegion.Borders.LineStyle = 1
  31.     End With
  32. End Sub
复制代码
回复

使用道具 举报

发表于 2015-3-31 13:23 | 显示全部楼层
稍微优化一下,少用Find语句
  1. Sub tt()
  2.     arr = Array("", "豆腐干", "牡蛎", "葡萄干", "苹果")
  3.     With ActiveSheet
  4.         For i = 0 To 3      '插入列,并填入表头
  5.             c = IIf(i = 0, 12, .Rows(1).Find(arr(i)).Column)
  6.             .Columns(c).Insert
  7.             .Cells(1, c) = arr(i + 1) & "比例"
  8.         Next
  9.         .[a65536].End(3).Offset(1) = "合计"
  10.         brr = .[a1].CurrentRegion
  11.         c1 = 2
  12.         For j = 1 To UBound(brr, 2)       '找到计算比例的列
  13.             If InStr(brr(1, j), "比例") > 0 Then    '待计算品种的起始列
  14.                 s1 = 0        '待计算品种求和
  15.                 s2 = 0        '所有品种求和
  16.                 For i = 2 To UBound(brr) - 1
  17.                     s = 0      '本行所有品种求和
  18.                     s1 = s1 + brr(i, c1)        '待计算品种求和
  19.                     For k = c1 To j - 1   '开始列--结束列累加
  20.                         s = s + brr(i, k)       '本行所有品种求和
  21.                         s2 = s2 + brr(i, k)      '所有品种求和
  22.                     Next
  23.                     If s > 0 Then brr(i, j) = brr(i, c1) / s       '计算比例
  24.                 Next
  25.                 If s2 > 0 Then brr(i, j) = s1 / s2      '计算合计比例
  26.                 c1 = j + 1     '下一种品种的起始列
  27.             End If
  28.         Next
  29.         .[a1].CurrentRegion = brr
  30.         .[a1].CurrentRegion.Columns.AutoFit
  31.         .[a1].CurrentRegion.Borders.LineStyle = 1
  32.     End With
  33. End Sub
复制代码
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 21:03 , Processed in 1.222851 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表