[已解决]根据合并区域计算

一成不变变 · 发表于 2015-12-2 18:09

我想实现，比如：Range("a1:b10")是合并的，那么Range("C1")等于Range("B1:B10")内数字之和，不知怎样写代码，请帮忙，谢谢

最佳答案

爱疯

2015-12-2 20:20

Sub test()
Dim r As Range, x, y, z

Application.ScreenUpdating = False
z = Range("b65536").End(xlUp).Row
Range("a1:a" & z).Copy [c1]
For Each r In Range("a1:a" & z)
      '如果r是合并单元格，且r地址等于r所在合并区域的首个单元格地址
      If r <> "" Or r.MergeCells And r.Address = r.MergeArea.Cells(1).Address Then
         x = r.MergeArea.Row
         y = x + r.MergeArea.Count - 1
         Cells(x, 3) = Application.Sum(Range(Cells(x, 2), Cells(y, 2)))
      End If
Next r

With Range("c1:c" & z)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
End With
End Sub

试验3.rar (17.36 KB, 下载次数: 18)

爱疯 · 发表于 2015-12-2 19:15

Sub test()
Dim rng As Range
Dim x As Integer, y As Integer

For Each rng In Range("a1:a" & Range("b65536").End(xlUp).Row)
      '如果 rng 是合并单元格，且 rng 地址等于 rng 所在合并区域的首个单元格地址
      If rng <> "" Or rng.MergeCells And rng.Address = rng.MergeArea.Cells(1).Address Then
         x = rng.MergeArea.Row
         y = x + rng.MergeArea.Count - 1
         Cells(y, 3) = getSum(x, y)
      End If
Next rng
End Sub

Function getSum(x, y) As Integer
Dim i, s
For i = x To y
      s = s + Cells(i, 2)
Next i
getSum = s
End Function

试验2.rar (18.39 KB, 下载次数: 11)

amzxfgh9632 · 发表于 2015-12-2 20:00

爱疯发表于 2015-12-2 19:15
Sub test()
Dim rng As Range
Dim x As Integer, y As Integer

老师如果这样呢

爱疯 · 发表于 2015-12-2 20:20

Sub test()
Dim r As Range, x, y, z

Application.ScreenUpdating = False
z = Range("b65536").End(xlUp).Row
Range("a1:a" & z).Copy [c1]
For Each r In Range("a1:a" & z)
      '如果r是合并单元格，且r地址等于r所在合并区域的首个单元格地址
      If r <> "" Or r.MergeCells And r.Address = r.MergeArea.Cells(1).Address Then
         x = r.MergeArea.Row
         y = x + r.MergeArea.Count - 1
         Cells(x, 3) = Application.Sum(Range(Cells(x, 2), Cells(y, 2)))
      End If
Next r

With Range("c1:c" & z)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
End With
End Sub

试验3.rar (17.36 KB, 下载次数: 18)

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

[已解决]根据合并区域计算

评分