[已解决]如何自动插入空行并计算平均数

shzzhy

    求大神帮忙，先谢谢了。
    按地区进行分组，表中仅提供简化内容，绝大多数为5个一组的数据，希望按5个一组求平均值，不足5个的插入空白行补足5行，并再插入一行求平均值。具体要求详见附件。

	初始数据
区号	地区	产品1	产品2	产品3
1	南京	53	66	66
2	南京	81	86	83
3	南京	56	65	59
4	上海	80	80	74
5	上海	76	84	80
6	上海	76	76	75
7	上海	76	76	74
8	苏州	85	83	75
9	苏州	77	81	74
10	无锡	67	81	82
11	杭州	89	79	77
12	杭州	70	61	60
13	杭州	80	77	70
14	杭州	80	80	79
15	杭州	81	78	88
16	北京	79	83	81
17	北京	79	85	85
18	北京	76	82	86
19	北京	84	87	86
20	北京	77	83	74
21	北京	79	77	74
22	昆山	66	75	76
23	昆山	74	89	73
24	昆山	62	80	75

最佳答案

月排行榜 / 总排行榜

爱疯

2016-4-27 23:17

Option Explicit

Sub Click()
    Dim A, B, i, j, r, s, blk

    '确保B列已排序
    A = Sheets(1).Range("a1").CurrentRegion
    ReDim B(1 To 10 ^ 4, 1 To UBound(A, 2))
    r = 6

    For i = 2 To UBound(A)
        '1）i大于2意思是除了第2行之外，如果上下地区不同
        If i > 2 And A(i, 2) <> A(i - 1, 2) Then
            'r-s 表示其它行(空行和平均行）的行数，最后由blk累加
            blk = blk + r - s
            Call test2(A, B, r, i, blk)
            s = 0
        End If

        '2）无论上下地区是否一样，某地区的记录数s必须<r（否则，就丢弃）
        s = s + 1
        If s < r Then
            For j = 1 To UBound(A, 2)
                '当前行 = 累计记录行数i + 累计其它行行数blk
                B(i + blk, j) = A(i, j)
            Next j
        End If
    Next i
    '末尾地区未进行比较，所以循环结束后单独处理平均行
    blk = blk + r - s
    Call test2(A, B, r, i, blk)

    '3）输出到工作表
    Sheets(2).Activate
    Cells.Clear
    Range("a1").Resize(i + blk, UBound(B, 2)) = B
    [a1:e1].Value = Sheets(1).[a1:e1].Value
    [a1].Select
End Sub

'处理平均行
Sub test2(A, B, r, x, blk)
    Dim i, j, p, q, pj

    'x是数据源中当前地区的下一地区，首记录的行号
    '减1并加blk，才是结果表的平均行行号
    pj = (x - 1) + blk

    '求各产品的平均值
    '从产品1（第3列）到产品3（最后1列）
    For j = 3 To UBound(A, 2)
        p = 0: q = 0
        '从当前地区的第1行，到当前地区的第5行
        For i = pj - r + 1 To pj - 1
            '如果产品数不为空（即非空行）
            If B(i, j) <> "" Then
                '累计该产品的和
                p = p + B(i, j)
                '累计该产品的次数
                q = q + 1
                '更新序号
                B(pj, 1) = B(i, 1)
            End If
        Next i
        '得到该产品的平均数
        B(pj, j) = Format(p / q, "0.000")
    Next j

    B(pj, 1) = "  " & B(pj - r + 1, 1) & "-" & B(pj, 1)
    B(pj, 2) = "平均"
End Sub

6.rar (64.21 KB, 下载次数: 10)

2016-4-27 23:02 上传

点击文件名下载附件



1）已加注释，关键是"其它行行数blk"的作用。
2）问题1和问题2，不知是不是这意思？
3）问题3看不懂。


有的需求，如求平均行，要能用数据透视表、函数处理，也行会好点。
因为代码数量会少些，就不太繁琐，以便阅读和修改。

跳转到最佳答案楼层

shzzhy

"要求用VBA实现：
1、每个城市数量不一样，不足5个的要求插入空行补足5个，超过5个的不插入空行补也不减；
2、每个城市按5个一组，在第5个后插入空行并求平均值，平均值行单元格颜色灰色填充；
3、一组等于或超过5个的，仅插入空行求平均值，并将字体标红；
4、一组5个的占大多数，希望对于这类的不要逐个数据计算平均数，而是可以复制第一个5个一组的公式进行粘贴公式，一组多于5个或少于5个可以逐个计算；  "                                
                                
                                

		结果数据
	区号	地区	产品1	产品2	产品3
1	1	南京	53	66	66
2	2	南京	81	86	83
3	3	南京	56	65	59
4
5
平均	1-3	南京平均	63.33	72.33	69.33
1	4	上海	80	80	74
2	5	上海	76	84	80
3	6	上海	76	76	75
4	7	上海	76	76	74
5
平均	4-7	上海平均	77.00	79.00	75.75
1	8	苏州	85	83	75
2	9	苏州	77	81	74
3
4
5
平均	8-9	苏州平均	81.00	82.00	74.50
1	10	无锡	67	81	82
2
3
4
5
平均	10-	无锡平均	67.00	81.00	82.00
1	11	杭州	89	79	77
2	12	杭州	70	61	60
3	13	杭州	80	77	70
4	14	杭州	80	80	79
5	15	杭州	81	78	88
平均	11-15	杭州平均	80.00	75.00	74.80
1	16	北京	79	83	81
2	17	北京	79	85	85
3	18	北京	76	82	86
4	19	北京	84	87	86
5	20	北京	77	83	74
6	21	北京	79	77	74
平均	16-21	北京平均	79.00	82.83	81.00
1	22	昆山	66	75	76
2	23	昆山	74	89	73
3	24	昆山	62	80	75
4
5
平均	22-24	昆山平均	67.33	81.33	74.67

                              
                                
                                
                                
                                
                                
                                
                                
                                
                                
                                
                                
                                
                                
                                
                                

baksy

附件

shzzhy

baksy 发表于 2016-4-24 07:00
附件

   你好，多谢帮忙。
   这个公式可以解决问题，但我是想用VBA程序来做。因为“源”中的数据原本不是整齐排列的，而是杂乱的，是排序后的结果。
   因此，最好是VBA程序，这样可以和前面的排序程序联系起来。
   请再帮忙给个VBA程序行吗？

shzzhy

请各位大神多帮帮忙呀

爱疯

5.rar (20.59 KB, 下载次数: 10)

2016-4-24 20:45 上传

点击文件名下载附件





Sub Click()
    Dim A, B, i, j, r, s, blk

    A = Sheets(1).Range("a1").CurrentRegion
    ReDim B(1 To 10 ^ 4, 1 To UBound(A, 2))
    r = 6

    For i = 2 To UBound(A)
        '1）求平均
        If i > 2 And A(i, 2) <> A(i - 1, 2) Then
            blk = blk + r - s    '求空行数，并累计。
            Call test2(A, B, r, i, blk)
            s = 0    '归零
        End If
        '2）录入
        s = s + 1
        If s < r Then
            For j = 1 To UBound(A, 2)
                B(i + blk, j) = A(i, j)
            Next j
        End If
    Next i
    blk = blk + r - s    '求空行数，并累计。
    Call test2(A, B, r, i, blk)

    Sheets(2).Activate
    Cells.Clear
    Range("a1").Resize(i + blk, UBound(B, 2)) = B
    [a1:e1].Value = Sheets(1).[a1:e1].Value
    [a1].Select
End Sub

Sub test2(A, ByRef B, r, x, blk)
    Dim i, j, p, q, pj

    pj = x + blk - 1    '平均行的行号
    B(pj, 1) = A(x - 1, 2) & "平均"

    For j = 3 To UBound(A, 2)
        p = 0: q = 0
        For i = pj - r + 1 To pj - 1
            If B(i, j) <> "" Then
                q = q + 1
                p = p + B(i, j)
            End If
        Next i
        B(pj, j) = Format(p / q, "0.000")
    Next j
End Sub

shzzhy

爱疯 发表于 2016-4-24 20:46
Sub Click()
    Dim A, B, i, j, r, s, blk

　　多谢爱疯版主帮助，非常感谢。仍有几处问题还需要请您帮忙解决。
　　附上“原始数据表”与得到的“统计结果表”，请多多帮忙。

1、如何能将“区号”这列进行由小到大的连接在一起；

2、如何将“地区”这列的平均值行均标为“平均”两个字；

3、如果后面有文本的话怎么办？想比较文字的多少或一致性，比如“圆”比“椭”多，在平均值行就取“圆”

4、目前您这个程序是效果最好的，上面的问题如能解决就非常完美了。您的程序代码还是没弄清楚，能否再标详细些，并将运算过程解释下，以便于理解。

爱疯

Option Explicit

Sub Click()
    Dim A, B, i, j, r, s, blk

    '确保B列已排序
    A = Sheets(1).Range("a1").CurrentRegion
    ReDim B(1 To 10 ^ 4, 1 To UBound(A, 2))
    r = 6

    For i = 2 To UBound(A)
        '1）i大于2意思是除了第2行之外，如果上下地区不同
        If i > 2 And A(i, 2) <> A(i - 1, 2) Then
            'r-s 表示其它行(空行和平均行）的行数，最后由blk累加
            blk = blk + r - s
            Call test2(A, B, r, i, blk)
            s = 0
        End If

        '2）无论上下地区是否一样，某地区的记录数s必须<r（否则，就丢弃）
        s = s + 1
        If s < r Then
            For j = 1 To UBound(A, 2)
                '当前行 = 累计记录行数i + 累计其它行行数blk
                B(i + blk, j) = A(i, j)
            Next j
        End If
    Next i
    '末尾地区未进行比较，所以循环结束后单独处理平均行
    blk = blk + r - s
    Call test2(A, B, r, i, blk)

    '3）输出到工作表
    Sheets(2).Activate
    Cells.Clear
    Range("a1").Resize(i + blk, UBound(B, 2)) = B
    [a1:e1].Value = Sheets(1).[a1:e1].Value
    [a1].Select
End Sub

'处理平均行
Sub test2(A, B, r, x, blk)
    Dim i, j, p, q, pj

    'x是数据源中当前地区的下一地区，首记录的行号
    '减1并加blk，才是结果表的平均行行号
    pj = (x - 1) + blk

    '求各产品的平均值
    '从产品1（第3列）到产品3（最后1列）
    For j = 3 To UBound(A, 2)
        p = 0: q = 0
        '从当前地区的第1行，到当前地区的第5行
        For i = pj - r + 1 To pj - 1
            '如果产品数不为空（即非空行）
            If B(i, j) <> "" Then
                '累计该产品的和
                p = p + B(i, j)
                '累计该产品的次数
                q = q + 1
                '更新序号
                B(pj, 1) = B(i, 1)
            End If
        Next i
        '得到该产品的平均数
        B(pj, j) = Format(p / q, "0.000")
    Next j

    B(pj, 1) = "  " & B(pj - r + 1, 1) & "-" & B(pj, 1)
    B(pj, 2) = "平均"
End Sub

6.rar (64.21 KB, 下载次数: 10)

2016-4-27 23:02 上传

点击文件名下载附件



1）已加注释，关键是"其它行行数blk"的作用。
2）问题1和问题2，不知是不是这意思？
3）问题3看不懂。


有的需求，如求平均行，要能用数据透视表、函数处理，也行会好点。
因为代码数量会少些，就不太繁琐，以便阅读和修改。

shzzhy

爱疯 发表于 2016-4-27 23:17
Option Explicit

Sub Click()

多谢您出手相助，您提供的程序完全可以解决我最初提供的数据。
问题1、2已完全解决，再次表示感谢！
问题3我已在附件文中标明，主要就是如果有文本格式的数据怎么办。

爱疯

如果有文本格式的数据

不理解这句的意思，能举例具体说明吗？