Excel VB开发表格页面project part config，有若干行数据，从第二行开始为正式数据，第一行为标题，A列是物料号指、其中A列有重复的物料号，B列物料描述值，但F列不同的采购单价值。当点击按钮控件之后，计算所有物料号的平均采购单价，每个物料号的平均采购单价=该物料号的所有行的采购单价算术平均值。并将计算值，输出到另一页面 database 的A列、B列和C列不为空的单元格，不能覆盖database 页面A列、B列、C列单元格既有的数据。要求，A列为传输的值为物料号、B列传输的值为平均值、C列传输的值为物料描述。

<think>好的，我需要帮助用户解决Excel VBA开发中的问题。首先，我需要理解用户的需求。用户有一个包含多个数据行的工作表，从第二行开始是正式数据，第一行是标题。A列是物料号，可能存在重复；B列是物料描述；F列是不同的采购单价。用户希望点击按钮后，计算每个物料号的平均采购单价，并将结果输出到另一个名为“database”的工作表中，要求不覆盖A、B、C列已有的数据，且这些列不为空的单元格。 首先，我需要考虑如何读取数据。用户的数据从第二行开始，所以循环应该从行号2开始，直到最后一行。需要确定最后一行的方法，通常使用UsedRange或Find方法。然后，需要将A列的物料号收集起来，并计算每个物料号对应的F列的平均值。这里可能需要使用字典对象来存储每个物料号的总值和计数，以便后续计算平均值。 接下来，处理重复的物料号。使用字典，键为物料号，值为一个数组，包含总和和计数。每次遇到相同的物料号，就累加F列的值并增加计数。这样在最后遍历字典时，可以计算每个物料号的平均值。 然后，关于物料描述的问题。用户提到B列是物料描述，但每个物料号可能有不同的描述吗？如果同一物料号的描述不同，如何处理？可能需要取第一个出现的描述，或者确保同一物料号的描述一致。这里假设同一物料号的描述是相同的，所以只需要在字典中存储对应的描述即可。 接下来是输出到“database”工作表。需要找到A、B、C列不为空的行，并将结果填入下一个空白行。这里需要确定如何找到最后一个非空行，通常从最后一行向上查找，直到找到有数据的行，然后从下一行开始写入。需要注意的是，不能覆盖已有数据，所以必须定位到第一个空白行。 在VBA代码中，需要处理可能出现的错误，例如工作表不存在的情况，或者F列的值不是数字的情况。需要添加错误处理，例如On Error Resume Next或检查是否为数字。 代码步骤大致如下： 1. 读取原始数据，使用字典存储物料号的总值和计数，以及物料描述。 2. 计算每个物料号的平均值。 3. 定位到“database”工作表，找到A、B、C列最后一个非空行后的起始行。 4. 将结果写入“database”工作表的相应列。 需要注意的细节包括： - 确保“database”工作表存在，否则需要处理错误。 - 处理F列可能存在的非数值数据，避免计算错误。 - 确保物料描述正确对应，可能需要检查同一物料号的描述是否一致。 - 最后写入数据时，要正确设置行号，避免覆盖现有数据。 可能的代码结构： - 使用Dictionary对象（需要引用Scripting.Runtime）。 - 循环遍历数据行。 - 计算平均值。 - 查找目标工作表的写入位置。 - 写入数据。 还需要测试代码，例如是否有重复物料号，F列有非数字值，或者“database”工作表为空的情况。确保在各种情况下都能正确运行。</think>以下是分步解决方案及实现代码： 1. 创建字典存储计算数据 ```vb Sub CalculateAverage() Dim srcSheet As Worksheet, dbSheet As Worksheet Dim lastRow As Long, i As Long Dim dict As Object Dim key As String, desc As String Dim total As Double, count As Long Set dict = CreateObject("Scripting.Dictionary") ' 设置数据源工作表 On Error Resume Next Set srcSheet = ThisWorkbook.Sheets("Project Part Config") ' 修改为实际工作表名 Set dbSheet = ThisWorkbook.Sheets("database") On Error GoTo 0 If srcSheet Is Nothing Or dbSheet Is Nothing Then MsgBox "工作表不存在！" Exit Sub End If ' 获取数据最后行 lastRow = srcSheet.Cells(srcSheet.Rows.count, "A").End(xlUp).Row ' 遍历数据行（从第2行开始） For i = 2 To lastRow key = Trim(srcSheet.Cells(i, 1).Value) desc = Trim(srcSheet.Cells(i, 2).Value) fValue = srcSheet.Cells(i, 6).Value ' 跳过无效数据 If key = "" Or Not IsNumeric(fValue) Then GoTo Continue ' 更新字典数据 If dict.Exists(key) Then dict(key)(0) = dict(key)(0) + CDbl(fValue) dict(key)(1) = dict(key)(1) + 1 Else dict.Add key, Array(CDbl(fValue), 1, desc) End If Continue: Next i ``` 2. 查找database工作表写入位置 ```vb ' 确定database工作表写入起始行 Dim dbLastRow As Long dbLastRow = dbSheet.Cells(dbSheet.Rows.count, "A").End(xlUp).Row ' 如果A列最后一个单元格非空，则从下一行开始 If dbSheet.Range("A" & dbLastRow).Value <> "" Then dbLastRow = dbLastRow + 1 End If ``` 3. 写入计算结果 ```vb ' 写入计算结果 Dim outputRow As Long outputRow = dbLastRow For Each key In dict.Keys avgValue = dict(key)(0) / dict(key)(1) ' 写入非空单元格验证 If dbSheet.Range("A" & outputRow).Value = "" And _ dbSheet.Range("B" & outputRow).Value = "" And _ dbSheet.Range("C" & outputRow).Value = "" Then dbSheet.Range("A" & outputRow).Value = key dbSheet.Range("B" & outputRow).Value = avgValue dbSheet.Range("C" & outputRow).Value = dict(key)(2) outputRow = outputRow + 1 Else ' 如果发现非空单元格则跳过 outputRow = outputRow + 1 End If Next key MsgBox "计算完成，共处理 " & dict.count & " 个物料号" End Sub ``` 代码特性说明： 1. 数据验证机制 - 自动跳过空物料号和非数字采购价 - 处理工作表不存在的情况 - 使用`Trim()`函数消除空格影响 2. 安全写入机制 - 三重验证：同时检查A/B/C列是否为空 - 自动寻找第一个完全空行 - 严格遵循不覆盖现有数据原则 3. 性能优化 - 使用字典对象提高处理速度 - 批量写入建议：如需处理大数据量，可将结果存入数组后一次性写入 4. 错误处理 - 增加`On Error Resume Next`防止意外中断 - 显式类型转换`CDbl()`确保数值安全 使用步骤： 1. 插入按钮控件 2. 右键按钮选择「指定宏」 3. 选择`CalculateAverage`过程 4. 测试时建议备份数据 扩展建议： - 添加数据验证（例如物料号格式检查） - 增加进度条显示 - 添加日志记录功能 - 实现异常数据高亮显示 可通过以下方式优化： ```vb ' 在循环前添加 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' 在过程结束前添加 Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic ```