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

shzzhy

爱疯 发表于 2016-4-28 20:12
如果有文本格式的数据

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

有带文本格式的，也有空格的。详见附件中的“原始数据表”，所要的结果是后面的“统计结果表”。
还请爱疯版主再次伸出援助之手。

爱疯

shzzhy 发表于 2016-4-29 08:17
有带文本格式的，也有空格的。详见附件中的“原始数据表”，所要的结果是后面的“统计结果表”。
还请爱 ...

比如，哪几个单元格是应该是什么格式，可实际上是什么格式？

shzzhy

爱疯 发表于 2016-4-29 08:57
比如，哪几个单元格是应该是什么格式，可实际上是什么格式？

1、sheet1中的F、G、H三列的数据均为文本格式；“原始数据表”中的“粒形”、“粒色”、“脐色”、“籽粒光泽”四列均为文本型
2、例如：其中地区为“北京”的有6行数据，其中F列“产品1颜色”有5个“椭”和1个“圆”，“椭”的数量大于“圆”的数量，则在平均值行赋值为，“椭”。
3、例如：“原始数据表”中“公0906-19”的“脐色”列，有3个“褐”和2个“黄”，“褐”的数量大于“黄”的数量，则在平均值行赋值为，“褐”。

爱疯

shzzhy 发表于 2016-4-29 10:59
1、sheet1中的F、G、H三列的数据均为文本格式；“原始数据表”中的“粒形”、“粒色”、“脐色”、“籽粒 ...

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
    Dim dic As Object

    Set dic = CreateObject("scripting.dictionary")
    '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
                '判断该产品是不是数字类型
                If Val(B(i, j)) = B(i, j) Then
                    '是
                    '累计该产品的和
                    p = p + B(i, j)
                    '累计该产品的次数
                    q = q + 1
                Else
                    '不是
                    dic(B(i, j)) = dic(B(i, j)) + 1
                End If
                '更新序号
                B(pj, 1) = B(i, 1)
            End If
        Next i
        '得到该产品的平均数
        If q Then B(pj, j) = Format(p / q, "0.000") Else B(pj, j) = getMaxText(dic.keys, dic.items)
    Next j

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

'获取最多次数的文本产品
Function getMaxText(k, t) As String
    Dim i%, x%, y%
    For i = 0 To UBound(k)
        If x < t(i) Then y = i
    Next i
    getMaxText = k(y)
End Function



7.rar (65.92 KB, 下载次数: 7)

2016-4-29 11:46 上传

点击文件名下载附件

爱疯

现在是这么定义的，比如圆和椭：

如果次数一样，那么谁先出现，平均值就是谁。
如果不一样，那么平均值就是次数多的那个。

shzzhy

非常感谢爱疯老师，您的程序太简洁了，我先好好学习您的程序和思路，如有不明白之处还请您多多指教！

shzzhy

爱疯 发表于 2016-4-29 12:23
现在是这么定义的，比如圆和椭：

如果次数一样，那么谁先出现，平均值就是谁。

爱疯老师好，刚才运行了下，发现3处问题：
1、三列文本列的标题头不能标上；
2、北京、杭州、南京三个地区在F列的平均值行，有误。如北京的F列，”椭“的数量大于”圆“的数量，但结果却显示的是”圆“；

爱疯

8.rar (66.15 KB, 下载次数: 5)

2016-4-30 17:52 上传

点击文件名下载附件

问题1之前写成固定区域，已改为动态选择
问题2粗心搞错了，已修改

shzzhy

谢谢，已完全正常了。

shzzhy

爱疯 发表于 2016-4-30 17:55
问题1之前写成固定区域，已改为动态选择
问题2粗心搞错了，已修改

    爱疯老师，上次运行时检查看过是对的，今天打开运行时发现还是不对。
    错误出现在“产品1颜色”列，北京、杭州、南京的平均行。