选定一个区域，用代码合并区域中部分单元格并显示计算结果

wssf · 发表于 2020-3-14 14:51

本帖最后由 wssf 于 2020-3-14 14:55 编辑

各位老师：有一个报表，需要某些相同编号的部分单元格合并后填计算结果，工作量大，请各位老师帮忙，有没有可能用鼠标选定区域后用代码完成。请见附件
谢谢！

shenjianrong163 · 发表于 2020-3-14 17:21

复制代码

shenjianrong163 · 发表于 2020-3-14 17:23

请参考附件：

求助.rar (211.3 KB, 下载次数: 4)

wssf · 发表于 2020-3-14 18:55

谢谢shenjianrong163 老师！大神啊，真是太好了。帮了大忙！

wssf · 发表于 2020-3-15 13:35

shenjianrong163老师好：

当选定编号是2行或大于3行区域时，结果计算有误。请得空时看一下
谢谢！

shenjianrong163 · 发表于 2020-3-19 17:40

wssf 发表于 2020-3-15 13:35
shenjianrong163老师好：

当选定编号是2行或大于3行区域时，结果计算有误。请得空时看一下

Sub test()
Dim i, k, m, n, ave, max, min, rng As Range, arr, st
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Worksheets("Sheet1")
st = Array("A", "B", "F", "G", "H")
For Each rng In Selection
If m = 0 Then m = rng.Row
n = rng.Row
If max = 0 Then max = .Range("C" & rng.Row).Value
If max < .Range("C" & rng.Row).Value Then max = .Range("C" & rng.Row).Value
If min = 0 Then min = .Range("C" & rng.Row).Value
If min > .Range("C" & rng.Row).Value Then min = .Range("C" & rng.Row).Value
Next
For i = 0 To 4
.Range(st(i) & m & ":" & st(i) & n).UnMerge
.Range(st(i) & m & ":" & st(i) & n).Merge
Next
k = (n + 1 - m) / 3
For i = 0 To k - 1
.Range("D" & m + i * 3) = Application.Average(.Range("C" & m + i * 3 & ":C" & m + i * 3 + 2))
ave = ave + .Range("D" & m + i * 3).Value * .Range("E" & m + i * 3).Value
Next
.Range("F" & m) = ave / 8
.Range("G" & m) = max
.Range("H" & m) = min
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

复制代码

shenjianrong163 · 发表于 2020-3-19 17:41

请参考附件：

求助.rar (211.68 KB, 下载次数: 3)

wssf · 发表于 2020-3-20 12:53

shenjianrong163老师：非常感谢！功能强大！慢慢学习。

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

[求助] 选定一个区域，用代码合并区域中部分单元格并显示计算结果