[已解决]求爱疯老师再出手帮忙“如何自动插入空行并计算平均数”

shzzhy

    爱疯老师好，一直在学习您编写的程序，目前为止仍然有些地方不明白，另还发现计算结果中有些问题，想请教您。已在原贴中联系您了，怕您看不到，又重新发此贴。
发现的问题：
1、在平均值行中，有些平均值结果不对，已用黄色块标出。这只是找出了一部分，未全部验证。请老师难看是什么原因。
2、对计算的平均值的格式用了：arrResult(avg, j) = Format(sum / count,"0.00")，但好象不是全都有效，有些原始数据值、平均值小数点后有3位小数。还发现，如果有日期型的列，如G列为日期型，原始数据为“m.d”格式，程序中修改为arrResult(avg, j) = Format(sum / count,"m.d")，但计算出来的平均值为“yy/mm/dd”的格式，无法达到“m.d”格式。
3、A列中“排号”的平均值如第7行结果是“1-3”，对后面这个语句还是没理解：arrResult(avg, 1) = "  "& arrResult(startRow, 1) & "-" & arrResult(avg, 1)。因为在我的数据中，有时候会在“排号”前会增加1列“统计号”，这时“排号”就变成B列了，我偿试将公式修改为 arrResult(avg, 2) = "  "& arrResult(startRow, 2) & "-" & arrResult(endRow, 2)，三行求平均的没有空行的可以，而2行求平均的有1空行的（如排号为46、50），则只出现“46－”。
4、获取最多次数的条目这组程序中k、t、i等表示什么意思？而且If max < t(i) Then max = t(i): idx = i　　用冒号连接是什么意思？这组程序一直无法理解。

请爱疯老师百忙中能指点，先谢谢了！

最佳答案

月排行榜 / 总排行榜

爱疯

2016-12-12 14:06

shzzhy 发表于 2016-12-12 09:03
爱疯老师好，您修改的文件已下载验证，4楼问题3已解决。    但在平均行中还是没有“品种名称”、“平 ...

插入空行并求平均值（20160501 求平均问题）9.rar (97.43 KB, 下载次数: 8)

2016-12-12 14:05 上传

点击文件名下载附件


    '处理前5列
    arrResult(ProductAvg, 1) = ""                                                               'A列，统计号
    arrResult(ProductAvg, 2) = "  " & arrResult(startRow, 2) & "-" & arrResult(ProductAvg, 2)   'B列，排号
    arrResult(ProductAvg, 3) = "平均"                                                           'C列，材料序号2014年
    arrResult(ProductAvg, 4) = arrResult(startRow, 4)                                           'D列，材料名称
    arrResult(ProductAvg, 5) = "平均"                                                           'E列，株号


这5行代码，用于处理结果表里的前5列。
是这样吗？

跳转到最佳答案楼层

爱疯

Dim arr()                   '数据源
Dim arrResult()             '结果
Dim NotRecord As Integer    '非记录（指平均行或空白行）
Dim Record As Integer       '记录
Const LineCount = 6         '行数 = 5行记录 + 1行平均值

'主程序
Sub test()
    Dim i As Integer, j As Integer

    Sheets("原始数据表").Select
    arr = Range("a1").CurrentRegion.Value
    ReDim arrResult(1 To UBound(arr) * 2, 1 To UBound(arr, 2))
    NotRecord = 0
    Record = 0

    For i = 2 To UBound(arr)
        '如果本行和上行不同，则处理平均行
        If i > 2 And arr(i, 3) <> arr(i - 1, 3) Then
            Call AverageLine(i)
            Record = 0
        End If

        '某个产品进行添加记录
        Record = Record + 1
        If Record < LineCount Then
            For j = 1 To UBound(arr, 2)
                '结果的行号 = 累计的记录数 + 累计的非记录行数
                arrResult(i + NotRecord, j) = arr(i, j)
            Next j
        End If
    Next i
    '最后一个产品的平均行，单独处理
    Call AverageLine(i)

    Sheets(2).Activate
    Cells.Clear
    Range("E:Q").NumberFormat = "0.0"       '保留1位小数
    Range("Y:AA").NumberFormat = "0.00"     '保留2位小数
    Range("a1").Resize(i + NotRecord, UBound(arrResult, 2)) = arrResult     '结果
    Range("a1").Resize(1, UBound(arr, 2)) = Application.Index(arr, 1, 0)    '标题

End Sub

'处理平均行
Sub AverageLine(iData)
    Dim dic As Object               '字典，用于文本型产品的计数
    Dim ProductAvg As Long          '产品的平均行行号
    Dim ProductSum As Double        '数字型产品的和
    Dim ProductCount As Integer     '产品的累计次数
    Dim ProductColumn As Integer    '产品的参照列号
    Dim i As Integer, j As Integer, startRow As Integer, endRow As Integer

    Set dic = CreateObject("scripting.dictionary")
    NotRecord = NotRecord + (LineCount - Record)    'LineCount - Record表示非记录数，即平均行和空白行
    ProductAvg = iData + NotRecord - 1    '某产品的平均行行号 = 累计记录数 + 累计非记录数 - 1
    startRow = ProductAvg - LineCount + 1
    endRow = ProductAvg - 1

    '从第5列（株高cm），到最后1列（经济系数），求各产品的平均值
    For j = 5 To UBound(arr, 2)
        '1）清零
        ProductSum = 0: ProductCount = 0: ProductColumn = 0: dic.RemoveAll

        '2）求和
        For i = startRow To endRow
            '如果产品的值非空
            If arrResult(i, j) <> "" Then
                '如果产品的值是数字
                If IsNumeric(arrResult(i, j)) Then
                    '累计产品值的和
                    ProductSum = ProductSum + arrResult(i, j)
                End If
                '更新终止排号
                arrResult(ProductAvg, 1) = arrResult(i, 1)
            End If
        Next i

        '3）求次数
        '更新产品的参照列号
        Select Case j
        Case 9, 13
            ProductColumn = 15
        Case Else
            ProductColumn = j
        End Select
        '求和的列与求次数的列，因为可能不一样，所以必须再循环
        For i = startRow To endRow
            '如果产品的值非空
            If arrResult(i, ProductColumn) <> "" Then
                '如果产品的值是数字
                If IsNumeric(arrResult(i, ProductColumn)) Then
                    '数字型产品的累计次数
                    ProductCount = ProductCount + 1
                Else
                    '文本型产品的累计次数
                    dic(arrResult(i, ProductColumn)) = dic(arrResult(i, ProductColumn)) + 1
                End If
            End If
        Next i

        '4）求平均值
        If ProductCount Then arrResult(ProductAvg, j) = ProductSum / ProductCount   '数字型 = 和 / 次数
        If dic.count Then arrResult(ProductAvg, j) = getItem(dic.keys, dic.items)   '文本型 = 最多次数的条目
    Next j

    '&用于将多个文本连成一个文本，下句将： 两个空格 + 起始排号 + 减号 + 终止排号，连成一个字符串。
    arrResult(ProductAvg, 1) = "  " & arrResult(startRow, 1) & "-" & arrResult(ProductAvg, 1)    '结果的A列、B列
    arrResult(ProductAvg, 2) = "平均"    '结果的B列
End Sub

'自定义函数：最多次数的条目
Function getItem(k, t) As String
    Dim i As Integer
    Dim temp As Integer     '最大次数
    Dim Id As Integer       '最大次数的下标
    For i = 0 To UBound(k)
        'k是条目的数组，t是条目次数的数组
        If temp < t(i) Then
            temp = t(i)     '最大次数
            Id = i          '最大次数的下标
        End If
    Next i
    getItem = k(Id)    '最大次数下标对应的条目
End Function
插入空行并求平均值（20160501 求平均问题）7.rar (83.7 KB, 下载次数: 9)

2016-12-4 17:29 上传

点击文件名下载附件



1）第1问，解决了吗？
2）第4问，作了注释。
3）为方便查看、阅读和理解，又改了些变量名和注释。
4）要完整写好需求，以便其它人能很快看懂。


没解决的，再一个个说，看能否理解，再看。

shzzhy

    多谢老师出手相助。前面描述不清楚，请见谅。看下面对问题的描述是否清楚。

shzzhy

爱疯 发表于 2016-12-4 17:39
Dim arr()                   '数据源
Dim arrResult()             '结果
Dim NotRecord As Integer     ...

    多谢老师出手相助。前面描述不清楚，请见谅。

1、问题1已解决。

但出现新问题：平均值行中无“材料名称”，见文件7-1中的“sheet2”。

2、问题2已解决。

3、新增问题：原始数据中一般在排号之前还增加了一列”统计号“，但对统计号不需要计算，在平均行中显示为空即可，其它条目不变，见文件7-2中的“原始数据表”。

4、对 “自定义函数：最多次数的条目”这块程序还是不太理解，因为还是对数组理解不够。

想以文件7-1中的“原始数据表”为基础向您请教：

1）“k是条目的数组”，是否可以这样理解：粒形、粒色、脐色、籽粒光泽等均为独立的一维数组，如“公0906-19”，其“粒形”列为一个数组，包含5个值，其“粒色”列、“脐色”列、“籽粒光泽”列均为独立的一个数组，各包含5个值；条目K数组就是：K（褐，褐，褐，黄，黄）。

褐

褐

褐

黄

黄

2）“t是条目次数的数组” ，是否可以这样理解：以“脐色”列为例，包含5个值

褐

褐

褐

黄

黄

t数组包含“褐”的次数和“黄”的次数。

3）Iftemp < t(i) Then  temp = t(i)     '最大次数

   temp最大次数还没统计出来，是如何确定的？不确定如何进行比较呢？

爱疯

插入空行并求平均值（20160501 求平均问题）8.rar (97.26 KB, 下载次数: 2)

2016-12-5 08:41 上传

点击文件名下载附件
4楼问题3，解决了吗？

shzzhy

爱疯 发表于 2016-12-5 08:41
4楼问题3，解决了吗？

    爱疯老师好，您修改的文件已下载验证，4楼问题3已解决。    但在平均行中还是没有“品种名称”、“平均”，已在附件中用黄色块标注，请您出手看看怎么修改？

爱疯

shzzhy 发表于 2016-12-12 09:03
爱疯老师好，您修改的文件已下载验证，4楼问题3已解决。    但在平均行中还是没有“品种名称”、“平 ...

插入空行并求平均值（20160501 求平均问题）9.rar (97.43 KB, 下载次数: 8)

2016-12-12 14:05 上传

点击文件名下载附件


    '处理前5列
    arrResult(ProductAvg, 1) = ""                                                               'A列，统计号
    arrResult(ProductAvg, 2) = "  " & arrResult(startRow, 2) & "-" & arrResult(ProductAvg, 2)   'B列，排号
    arrResult(ProductAvg, 3) = "平均"                                                           'C列，材料序号2014年
    arrResult(ProductAvg, 4) = arrResult(startRow, 4)                                           'D列，材料名称
    arrResult(ProductAvg, 5) = "平均"                                                           'E列，株号


这5行代码，用于处理结果表里的前5列。
是这样吗？

shzzhy

爱疯老师，我运行了下，太完美了，我的要求都能完成，太谢谢您了

shzzhy

您的程序非常简洁，学习很长时间了，还是没完全明白，还需要再好好学习

shzzhy

　　我还是没搞明白，空行是如何添加上去了？
　　以“插入空行并求平均值（20160501 求平均问题）9.rar”这个附件中的“sheet2”结果表为例，最后一组数据有6条记录，而计算时是以5条记录+1个平均行来计的，结果平均时就只有1-5这5条记录了，这如何修改呢？
　　我这用的数据很多都超过15条记录了，以“插入空行并求平均值（20160501 求平均问题）9.rar”这个附件中的“sheet2”结果表为例，我想将"sheet2"中的数据在平均行前面增加相应数量的空行，使数据组统一达到：记录数+空行＝20行的效果呢？