Excel精英培训网

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

[已解决]请教各位大神们

[复制链接]
发表于 2017-4-24 15:48 | 显示全部楼层 |阅读模式
请教各位大神  问题我在附件写出来了
最佳答案
2017-4-26 21:13

详见附件

book1.zip

8.34 KB, 下载次数: 14

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2017-4-24 21:11 | 显示全部楼层
回复

使用道具 举报

发表于 2017-4-24 21:39 | 显示全部楼层
没太看懂, "C列算出一共多少块,求和面积1"具体什么样子, 能举例说一下吗
回复

使用道具 举报

 楼主| 发表于 2017-4-24 22:03 | 显示全部楼层
france723 发表于 2017-4-24 21:39
没太看懂, "C列算出一共多少块,求和面积1"具体什么样子, 能举例说一下吗

左边不是C列不是有个合计: 块 0.00 亩嘛
回复

使用道具 举报

 楼主| 发表于 2017-4-24 22:06 | 显示全部楼层
france723 发表于 2017-4-24 21:39
没太看懂, "C列算出一共多少块,求和面积1"具体什么样子, 能举例说一下吗

面积2全部除以1.2得出面积1,一个合并单元格代表一户人家的田块,就是把那人家的所有田块数量算出来,然后把那一户人家每块田的面积1求和,比如:合计: 5块 1.00 亩

回复

使用道具 举报

 楼主| 发表于 2017-4-26 10:40 | 显示全部楼层
看样子是没办法解决了
回复

使用道具 举报

发表于 2017-4-26 15:27 | 显示全部楼层
本帖最后由 france723 于 2017-4-26 15:36 编辑
  1. Sub zzz()
  2. Dim y, i&, ar, j&, k, cr
  3. Dim m&, n&, p, q&, z&, x&, s, s1
  4. y = Range("b65536").End(3).Row
  5. h = Range("k65536").End(3).Row
  6. br = Range("k2:l" & h)
  7. For x = 1 To UBound(br)
  8.     br(x, 1) = br(x, 2) / 1.2
  9. Next x
  10. Range("k2").Resize(UBound(br), 2) = br
  11. ReDim ar(1 To y - 1)
  12. j = 1
  13. For i = 2 To y
  14.     k = Cells(i, 1).MergeArea.Rows.Count
  15.     ar(j) = k
  16.     j = j + 1
  17. Next i
  18. ReDim cr(1 To 1)
  19. cr(1) = 2
  20. n = 1
  21. For m = 2 To UBound(ar)
  22.     If ar(m) <> ar(m - 1) Then
  23.         n = n + 1
  24.         ReDim Preserve cr(1 To n)
  25.         cr(n) = m + 1
  26.     End If
  27. Next m
  28. q = 1
  29. For Each p In cr
  30.     k = Cells(p, 1).MergeArea.Rows.Count
  31.     s = 0
  32.     s1 = 0
  33.     For z = q To q + k - 1
  34.         s = s + br(z, 1)
  35.         s1 = s1 + br(z, 2)
  36.     Next z
  37.     Cells(p, 3) = "HeJi: " & k & " Kuai " & Left(s, 4) & " Mu"
  38.     Cells(p, 4) = "HeJi: " & k & " Kuai " & Left(s1, 4) & " Mu"
  39.     q = q + k
  40. Next p
  41. End Sub
复制代码

新手代码可能略复杂,但测试没有错误. 37,38行拼音换汉字即可

回复

使用道具 举报

 楼主| 发表于 2017-4-26 18:43 | 显示全部楼层
france723 发表于 2017-4-26 15:27
新手代码可能略复杂,但测试没有错误. 37,38行拼音换汉字即可

大神`第八行提示类型不匹配呀
回复

使用道具 举报

发表于 2017-4-26 19:41 | 显示全部楼层
冷月丶左少 发表于 2017-4-26 18:43
大神`第八行提示类型不匹配呀

之前有个地方忘记改了
  1. Sub zzz()
  2. Dim y, i&, ar, j&, k, cr
  3. Dim m&, n&, p, q&, z&, x&, s, s1
  4. y = Range("b65536").End(3).Row
  5. h = Range("l65536").End(3).Row
  6. br = Range("k2:l" & h)
  7. For x = 1 To UBound(br)
  8.     br(x, 1) = br(x, 2) / 1.2
  9. Next x
  10. Range("k2").Resize(UBound(br), 2) = br
  11. ReDim ar(1 To y - 1)
  12. j = 1
  13. For i = 2 To y
  14.     k = Cells(i, 1).MergeArea.Rows.Count
  15.     ar(j) = k
  16.     j = j + 1
  17. Next i
  18. ReDim cr(1 To 1)
  19. cr(1) = 2
  20. n = 1
  21. For m = 2 To UBound(ar)
  22.     If ar(m) <> ar(m - 1) Then
  23.         n = n + 1
  24.         ReDim Preserve cr(1 To n)
  25.         cr(n) = m + 1
  26.     End If
  27. Next m
  28. q = 1
  29. For Each p In cr
  30.     k = Cells(p, 1).MergeArea.Rows.Count
  31.     s = 0
  32.     s1 = 0
  33.     For z = q To q + k - 1
  34.         s = s + br(z, 1)
  35.         s1 = s1 + br(z, 2)
  36.     Next z
  37.     Cells(p, 3) = "HeJi: " & k & " Kuai " & Left(s, 4) & " Mu"
  38.     Cells(p, 4) = "HeJi: " & k & " Kuai " & Left(s1, 4) & " Mu"
  39.     q = q + k
  40. Next p
  41. End Sub
复制代码


回复

使用道具 举报

 楼主| 发表于 2017-4-26 19:44 | 显示全部楼层
france723 发表于 2017-4-26 19:41
之前有个地方忘记改了

大神,第八行还是出错  提示类型不匹配
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 17:46 , Processed in 0.439786 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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