10 鱼币
'已完成，作用：当表格执行删除行操作时候，标记isdeleteoperation为true，这样后续触发表变更事件会先写个代码判断跳过操作 Function IsDeleteOperation(Target As Range) As Boolean ' 修正工作表的引用方式（"报价输入页"是当前表名） With ThisWorkbook.Sheets("报价输入页") ' 特征1：检查是否选择整行 If Target.Rows.Count > 1 And Target.Columns.Count = .Columns.Count Then IsDeleteOperation = True Exit Function End If End With ' 特征2：撤消列表中包含"删除" On Error Resume Next Dim lastAction As String lastAction = Application.CommandBars("Standard").Controls("撤消").List(1) If InStr(lastAction, "删除") > 0 Then IsDeleteOperation = True On Error GoTo 0 ' 特征3：检查整行是否为空 Dim r As Range For Each r In Target.Rows If WorksheetFunction.CountA(r.EntireRow) = 0 Then IsDeleteOperation = True Exit For End If Next r End Function '已完成 Function IsDeletionCausedChange() As Boolean ' 原有逻辑（根据实际情况调整） IsDeletionCausedChange = False End Function ' 已完成，函数：在材料类型，材质，壁厚发生变更时，返回材料价格 Function Find_Mat_Price(ByVal cCellValue As String, ByVal dCellValue As String, ByVal fCellValue As Double, ByVal db2Sheet As Worksheet) As Double Dim i As Long Dim db2AValue As String Dim db2BValue As String Dim db2DValue As Double Dim db2EValue As Double Dim db2FValue As Double Dim lastRow As Long Dim matchRow As Long lastRow = db2Sheet.Cells(db2Sheet.Rows.Count, 1).End(xlUp).row matchRow = 0 ' 默认返回 0，表示未找到匹配行 For i = 3 To lastRow db2AValue = db2Sheet.Cells(i, 1).Value db2BValue = db2Sheet.Cells(i, 2).Value db2DValue = db2Sheet.Cells(i, 4).Value db2EValue = db2Sheet.Cells(i, 5).Value db2FValue = db2Sheet.Cells(i, 6).Value ' 确保 db2DValue 和 db2EValue 是数值类型 If IsNumeric(db2DValue) And IsNumeric(db2EValue) Then db2DValue = CDbl(db2DValue) db2EValue = CDbl(db2EValue) Else Debug.Print "db2DValue or db2EValue is not numeric: " & db2DValue & ", " & db2EValue Exit Function End If ' 检查是否符合条件 If db2AValue = cCellValue And db2BValue = dCellValue Then If fCellValue >= db2DValue And fCellValue <= db2EValue Then matchRow = i Exit For End If End If Next i ' 如果找到匹配行，返回材料单价 If matchRow > 0 Then Find_Mat_Price = db2Sheet.Cells(matchRow, 6).Value Else Find_Mat_Price = Empty ' 如果未找到匹配行，返回 -1 End If End Function '已完成，功能是在列外径或宽度，壁厚，长度发生变更的时候，根据内容修改体积的数值，用来计算体积的函数， Function calculate_volume(ByVal D As Double, ByVal T As Double, ByVal L As Double, ByVal name As String, ByVal density As Double) As Variant Dim volume As Double ' 根据名称判断类型并计算体积 If InStr(LCase(name), "管子") > 0 Then ' 如果外径、壁厚和长度均大于0，则执行计算 If D > 0 And T > 0 And L > 0 Then volume = (D - T) * 3.1416 * L * T / 1000 / 1000 Else volume = Empty End If ElseIf InStr(LCase(name), "封头") > 0 Then Dim Df As Double If D > 0 And T > 0 And L > 0 Then Df = 1.213 * D + 1.5 * L * 1000 + 2 * T volume = Df * Df * 3.1416 / 4 * T / 1000 / 1000 / 1000 Else volume = Empty End If ElseIf InStr(LCase(name), "板") > 0 Then If D > 0 And T > 0 And L > 0 Then volume = D * L * T / 1000 / 1000 Else volume = Empty End If Else ' 如果名称不符合条件，则返回空值 volume = Empty End If ' 返回计算结果 calculate_volume = volume End Function '计算锅筒拍片总数 Function count_numbers_shot(ByVal OD As Variant, ByVal length As Variant, ByVal quantity As Variant) As Variant ' 检查壁厚、长度和数量是否为数值且大于0 If IsNumeric(OD) And OD > 0 And _ IsNumeric(length) And length > 0 And _ IsNumeric(quantity) And quantity > 0 Then ' 如果所有条件满足，返回三列数值之和 count_numbers_shot = Int((CDbl(OD) * 3.14 * (CDbl(quantity) + 1) + CDbl(length) * CDbl(quantity) * 1000) / 280) + 10 Else ' 如果任何条件不满足，返回空值 count_numbers_shot = Empty End If End Function '抽取无损检测信息 Function NDT(ByVal row As Long) As Variant Dim baseValue As Double Dim discount As Double Dim proportion As String Dim pricePerShot As Double Dim actualShots As Long Dim ndtCost As Double Dim results(1) As Variant ' 获取拍片总数 If IsNumeric(Me.Range("拍片总数").Cells(row, 1).Value) Then baseValue = Me.Range("拍片总数").Cells(row, 1).Value Else baseValue = 0 End If ' 获取拍片比例并转换为数值 proportion = Me.Range("拍片比例").Cells(row, 1).Value If IsNumeric(Replace(proportion, "%", "")) Then discount = CDbl(Replace(proportion, "%", "")) / 100 Else discount = 1 ' 默认为 100% End If ' 获取拍片单价 If IsNumeric(Me.Range("拍片单价").Cells(row, 1).Value) And Me.Range("拍片单价").Cells(row, 1).Value > 0 Then pricePerShot = Me.Range("拍片单价").Cells(row, 1).Value Else pricePerShot = 0 End If ' 计算实际拍片数量和无损检测费 actualShots = Int(baseValue * discount) ndtCost = baseValue * pricePerShot * discount ' 返回结果 results(0) = actualShots results(1) = ndtCost NDT = results End Function '测试，抽取封头外加工费用，碳钢部分 Function cap_out_cost(ByVal D As Double, ByVal T As Double, ByVal mat As String, ByVal db7Sheet As Worksheet) As Variant Dim i As Long Dim matchRow As Long matchRow = 0 ' 在DB7表中查找符合条件的行 For i = 3 To db7Sheet.Cells(db7Sheet.Rows.Count, 1).End(xlUp).row Dim col1 As Double Dim col2 As Double Dim col3 As Double Dim col4 As Double ' 强制转换为Double类型 col1 = CDbl(db7Sheet.Cells(i, 1).Value) col2 = CDbl(db7Sheet.Cells(i, 2).Value) col3 = CDbl(db7Sheet.Cells(i, 3).Value) col4 = CDbl(db7Sheet.Cells(i, 4).Value) ' 比较条件 If D > col1 And D < col2 And T > col3 And T < col4 Then matchRow = i Exit For End If Next i ' 如果找到匹配的行，返回第五列的值 If matchRow > 0 Then ' 检查材质是否包含 "31" 或 "30" If InStr(mat, "31") > 0 Or InStr(mat, "30") > 0 Then cap_out_cost = db7Sheet.Cells(matchRow, 6).Value ElseIf Not IsEmpty(mat) Then cap_out_cost = db7Sheet.Cells(matchRow, 5).Value Else ' 如果材质不包含 "31" 或 "30"，返回空值 cap_out_cost = Empty End If Else cap_out_cost = Empty End If End Function '计算制作费总和 Function production_cost(ByVal row As Long, ByVal ws As Worksheet) As Double Dim weldingCost As Double Dim cuttingPaintingCost As Double Dim materialCost As Double Dim heatTreatmentCost As Double Dim nonDestructiveTestingCost As Double Dim outsourcingCost As Double Dim machiningCost As Double Dim weldingCost_hand As Double weldingCost = 0 cuttingPaintingCost = 0 materialCost = 0 heatTreatmentCost = 0 nonDestructiveTestingCost = 0 outsourcingCost = 0 machiningCost = 0 weldingCost_hand = 0 ' 检查装焊人工费 If IsNumeric(ws.Range("装焊人工费").Cells(row, 1).Value) Then weldingCost = CDbl(ws.Range("装焊人工费").Cells(row, 1).Value) End If ' 检查下料油漆费 If IsNumeric(ws.Range("下料油漆人工费").Cells(row, 1).Value) Then cuttingPaintingCost = CDbl(ws.Range("下料油漆人工费").Cells(row, 1).Value) End If ' 检查辅材费 If IsNumeric(ws.Range("辅材费").Cells(row, 1).Value) Then materialCost = CDbl(ws.Range("辅材费").Cells(row, 1).Value) End If ' 检查热处理费 If IsNumeric(ws.Range("热处理费").Cells(row, 1).Value) Then heatTreatmentCost = CDbl(ws.Range("热处理费").Cells(row, 1).Value) End If ' 检查无损检测费 If IsNumeric(ws.Range("无损检测费").Cells(row, 1).Value) Then nonDestructiveTestingCost = CDbl(ws.Range("无损检测费").Cells(row, 1).Value) End If ' 检查外协加工费 If IsNumeric(ws.Range("外协加工费").Cells(row, 1).Value) Then outsourcingCost = CDbl(ws.Range("外协加工费").Cells(row, 1).Value) End If ' 检查机加工费 If IsNumeric(ws.Range("机加工费").Cells(row, 1).Value) Then machiningCost = CDbl(ws.Range("机加工费").Cells(row, 1).Value) End If ' 检查焊口人工费 If IsNumeric(ws.Range("焊口人工费").Cells(row, 1).Value) Then weldingCost_hand = CDbl(ws.Range("焊口人工费").Cells(row, 1).Value) End If ' 计算总和 production_cost = weldingCost + cuttingPaintingCost + materialCost + heatTreatmentCost + nonDestructiveTestingCost + outsourcingCost + machiningCost + weldingCost_hand End Function '计算生产成本，材料费加制作费 Function calculate_production_cost(ByVal row As Long, ByVal ws As Worksheet) As Double Dim materialCost As Double Dim productionCost As Double materialCost = 0 productionCost = 0 ' 检查材料费 If IsNumeric(ws.Range("材料费").Cells(row, 1).Value) Then materialCost = CDbl(ws.Range("材料费").Cells(row, 1).Value) End If ' 检查制作费 If IsNumeric(ws.Range("制作费").Cells(row, 1).Value) Then productionCost = CDbl(ws.Range("制作费").Cells(row, 1).Value) End If ' 计算总和 calculate_production_cost = materialCost + productionCost End Function '已完成，用于选中时提供下拉列表供选择 ' 已完成，用于选中时提供下拉列表供选择 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim db1Sheet As Worksheet Dim db2Sheet As Worksheet Set db1Sheet = ThisWorkbook.Sheets("DB1类别") Set db2Sheet = ThisWorkbook.Sheets("DB2材料及单价") Dim targetCell As Range Dim cellBelow As Range Dim validationList As String Dim cellValue As String Dim i As Long ' 将Integer改为Long以避免循环溢出 Dim uniqueValues As Object Dim lastRow As Long lastRow = Me.Range("序号").Cells(Me.Rows.Count, 1).End(xlUp).row ' 修改：Target.Count -> Target.CountLarge If Not Intersect(Target, Me.Range("名称").Resize(Me.Rows.Count - 3).Offset(3, 0)) Is Nothing Then If Target.CountLarge = 1 Then ' 使用CountLarge Set targetCell = Target ' Set cellBelow = Me.Cells(targetCell.row + 1, targetCell.Column) Set cellBelow = Me.Cells(targetCell.row + 1, 1) Set cellBefore = Me.Cells(targetCell.row, 1) If IsEmpty(cellBelow.Value) And IsEmpty(cellBefore.Value) Then targetCell.Validation.Delete Dim dbLastRow As Long dbLastRow = db1Sheet.Cells(db1Sheet.Rows.Count, 1).End(xlUp).row validationList = "" For i = 2 To dbLastRow cellValue = db1Sheet.Cells(i, 1).Value If cellValue <> "" Then validationList = IIf(validationList = "", cellValue, validationList & "," & cellValue) End If Next i If validationList <> "" Then With targetCell.Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=validationList .IgnoreBlank = True .InCellDropdown = True End With End If End If End If End If ' 新增功能：当单元格值包含“换热管(下拉选择)”时，提供特定下拉列表“换热管1，换热管2” ' 当单元格值包含“钢钉(下拉选择)”时，提供特定下拉列表，内容取自“DB11钢钉重量及价格”表的第三行到最后一行的第2列的内容去重 If Not Intersect(Target, Me.Range("名称").Resize(Me.Rows.Count - 3).Offset(3, 0)) Is Nothing Then If Target.CountLarge = 1 Then ' 使用CountLarge Set targetCell = Target If InStr(targetCell.Value, "换热管(下拉选择)") > 0 Then targetCell.Validation.Delete With targetCell.Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="蛇形换热管,换热管+弯头" .IgnoreBlank = True .InCellDropdown = True End With ElseIf InStr(targetCell.Value, "钢钉(下拉选择)") > 0 Then targetCell.Validation.Delete Dim dbSheet As Worksheet Set dbSheet = ThisWorkbook.Sheets("DB11钢钉重量及价格") ' Dim lastRow As Long lastRow = dbSheet.Cells(dbSheet.Rows.Count, 2).End(xlUp).row ' Dim validationList As String Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") ' 读取并去重 For i = 3 To lastRow ' Dim cellValue As String cellValue = dbSheet.Cells(i, 2).Value If cellValue <> "" And Not dict.exists(cellValue) Then dict(cellValue) = True End If Next i ' 构建下拉列表 validationList = Join(dict.keys, ",") If validationList <> "" Then With targetCell.Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=validationList .IgnoreBlank = True .InCellDropdown = True End With End If End If End If End If ' ' 修改：Target.Count -> Target.CountLarge ' If Not Intersect(Target, Me.Range("材质").Resize(Me.Rows.Count - 3).Offset(3, 0)) Is Nothing Then ' If Target.CountLarge = 1 Then ' 使用CountLarge ' Set targetCell = Target ' If targetCell.row > 3 Then ' If InStr(Me.Cells(targetCell.row, 1).Value, ".") > 0 Then ' targetCell.Validation.Delete ' cCellValue = Me.Range("材料规格").Cells(targetCell.row, 1).Value ' ' Set uniqueValues = CreateObject("Scripting.Dictionary") ' For i = 2 To db2Sheet.Cells(db2Sheet.Rows.Count, 1).End(xlUp).row ' If db2Sheet.Cells(i, 1).Value = cCellValue Then ' cellValue = db2Sheet.Cells(i, 2).Value ' If cellValue <> "" And Not uniqueValues.exists(cellValue) Then ' uniqueValues.Add cellValue, Nothing ' End If ' End If ' Next i ' ' validationList = Join(uniqueValues.keys, ",") ' If validationList <> "" Then ' With targetCell.Validation ' .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ ' Operator:=xlBetween, Formula1:=validationList ' .IgnoreBlank = True ' End With ' End If ' End If ' End If ' End If ' End If ' 修改：Target.Count -> Target.CountLarge If Not Intersect(Target, Me.Range("材质").Resize(Me.Rows.Count - 3).Offset(3, 0)) Is Nothing Then If Target.CountLarge = 1 Then ' 使用CountLarge Set targetCell = Target If targetCell.row > 3 Then ' 检查名称单元格是否包含“钢钉” ' If InStr(Me.Cells(targetCell.row, 1).Value, "钢钉") > 0 Then If InStr(Me.Range("名称").Cells(targetCell.row, 1).Value, "钢钉") > 0 Then targetCell.Validation.Delete ' 从“DB11钢钉重量及价格”表的第3列获取去重后的值 ' Dim dbSheet As Worksheet Set dbSheet = ThisWorkbook.Sheets("DB11钢钉重量及价格") ' Dim lastRow As Long lastRow = dbSheet.Cells(dbSheet.Rows.Count, 3).End(xlUp).row ' Dim uniqueValues As Object Set uniqueValues = CreateObject("Scripting.Dictionary") ' 读取并去重 For i = 3 To lastRow ' Dim cellValue As String cellValue = dbSheet.Cells(i, 3).Value If cellValue <> "" And Not uniqueValues.exists(cellValue) Then uniqueValues.Add cellValue, Nothing End If Next i ' 构建下拉列表 ' Dim validationList As String validationList = Join(uniqueValues.keys, ",") If validationList <> "" Then With targetCell.Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=validationList .IgnoreBlank = True .InCellDropdown = True End With End If ElseIf InStr(Me.Range("名称").Cells(targetCell.row, 1).Value, "销钉") > 0 Then targetCell.Validation.Delete ' 从“DN14销钉重量及价格”表的第3列获取去重后的值 ' Dim dbSheet As Worksheet Set dbSheet = ThisWorkbook.Sheets("DB14销钉重量及价格") ' Dim lastRow As Long lastRow = dbSheet.Cells(dbSheet.Rows.Count, 3).End(xlUp).row ' Dim uniqueValues As Object Set uniqueValues = CreateObject("Scripting.Dictionary") ' 读取并去重 ' Dim i As Long ' Dim cellValue As String For i = 3 To lastRow cellValue = dbSheet.Cells(i, 3).Value If cellValue <> "" And Not uniqueValues.exists(cellValue) Then uniqueValues.Add cellValue, Nothing End If Next i ' 构建下拉列表 ' Dim validationList As String validationList = Join(uniqueValues.keys, ",") If validationList <> "" Then With targetCell.Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=validationList .IgnoreBlank = True .InCellDropdown = True End With End If ElseIf InStr(Me.Cells(targetCell.row, 1).Value, ".") > 0 Then targetCell.Validation.Delete cCellValue = Me.Range("材料规格").Cells(targetCell.row, 1).Value Set uniqueValues = CreateObject("Scripting.Dictionary") ' Dim db2Sheet As Worksheet ' Set db2Sheet = ThisWorkbook.Sheets("DB2材料及单价") For i = 2 To db2Sheet.Cells(db2Sheet.Rows.Count, 1).End(xlUp).row If db2Sheet.Cells(i, 1).Value = cCellValue Then cellValue = db2Sheet.Cells(i, 2).Value If cellValue <> "" And Not uniqueValues.exists(cellValue) Then uniqueValues.Add cellValue, Nothing End If End If Next i validationList = Join(uniqueValues.keys, ",") If validationList <> "" Then With targetCell.Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=validationList .IgnoreBlank = True End With End If End If End If End If End If ' 修改：Target.Count -> Target.CountLarge If Not Intersect(Target, Me.Range("拍片比例").Resize(Me.Rows.Count - 3).Offset(3, 0)) Is Nothing Then If Target.CountLarge = 1 Then ' 使用CountLarge Set targetCell = Target If targetCell.row > 3 Then targetCell.Validation.Delete Dim name2 As String name2 = Me.Range("名称").Cells(targetCell.row, 1).Value If InStr(name2, "筒节") > 0 And Me.Range("拍片总数").Cells(targetCell.row, 1).Value > 0 Then validationList = "100%,20%,10%" ElseIf InStr(name2, "换热管") > 0 And Me.Range("拍片总数").Cells(targetCell.row, 1).Value > 0 Then validationList = "100%,50%,10%,0" Else validationList = "" End If If validationList <> "" Then With targetCell.Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=validationList .IgnoreBlank = True End With End If End If End If End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) ' ------ 修正后的删除行判断逻辑 ------ If IsDeleteOperation(Target) Then Exit Sub ' 直接退出不修改事件状态 ' ----------------------------------- ' 原有的删除行移动检查（根据需求可选保留） If IsDeletionCausedChange() Then Exit Sub ' 保持原有的事件禁用检查 If Not Application.EnableEvents Then Exit Sub Dim targetCell As Range Dim cellValue As String Dim matchRow As Long Dim lastCol As Long Dim sourceRange As Range Dim destRow As Long Dim i As Integer Dim maxNumber As Double Dim currentRow As Long Dim isAllEmpty As Boolean Dim seqNumber As Double Dim db3MatchRow As Long Dim validationList As String Dim uniqueValues As Object Dim cCellValue As String Dim matPrice As Double ' 设置目标工作表 Dim dbSheet As Worksheet Set dbSheet = ThisWorkbook.Sheets("DB1类别") Dim db2Sheet As Worksheet Set db2Sheet = ThisWorkbook.Sheets("DB2材料及单价") Dim db3Sheet As Worksheet Set db3Sheet = ThisWorkbook.Sheets("DB3产品类型对应材料类型") Dim db4Sheet As Worksheet Set db4Sheet = ThisWorkbook.Sheets("DB4车间生产价格表") Dim db5Sheet As Worksheet Set db5Sheet = ThisWorkbook.Sheets("DB5无损检测价格") Dim db6Sheet As Worksheet Set db6Sheet = ThisWorkbook.Sheets("DB6热处理要求") Dim db7Sheet As Worksheet Set db7Sheet = ThisWorkbook.Sheets("DB7封头冲压价格表") Dim db10Sheet As Worksheet Set db10Sheet = ThisWorkbook.Sheets("DB10焊口价格表") Dim db11Sheet As Worksheet Set db11Sheet = ThisWorkbook.Sheets("DB11钢钉重量及价格") Dim db12Sheet As Worksheet Set db12Sheet = ThisWorkbook.Sheets("DB12标准件价格") Dim db14Sheet As Worksheet Set db14Sheet = ThisWorkbook.Sheets("DB14销钉重量及价格") '把外径，壁厚，长度，密度，体积放这里 Dim D As Double ' 外径或宽度 Dim T As Double ' 壁厚 Dim L As Double ' 长度 Dim name As String ' 名称 Dim density As Double ' 密度 Dim volume As Variant ' 体积 Dim upperRow As Long Dim lowerRow As Long Dim totalValue As Double Dim checkRow As Long Dim quantity As Variant Dim weight As Double Dim outsourceCost As Variant Dim productionCost As Double Dim weldingCost As Double Dim cuttingPaintingCost As Double Dim totalShopManagementCost As Double Dim man_weld As Double '焊口人工费定义 Dim totalShots As Variant ' 拍片总数，放最前面定义 Dim db4Row As Long Dim db4MatchRow As Long Dim allEmpty As Boolean Dim lastRow As Long lastRow = Me.Range("名称").Cells(Me.Rows.Count, 1).End(xlUp).row ' 动态计算最后一行 Dim totalManufacturingCost As Double ' 已完成，检查是否在“名称”列且行号大于3，生成框架，填充序号，并直接调用生成了材料规格 If Not Intersect(Target, Me.Range("名称").Rows("4:" & lastRow)) Is Nothing Then If Target.Count = 1 Then ' 确保是单个单元格被选中 Set targetCell = Target ' 找到匹配的行 matchRow = 0 For i = 2 To lastRow If dbSheet.Cells(i, 1).Value = targetCell.Value Then matchRow = i Exit For End If Next i ' 如果找到匹配的行 If matchRow > 0 Then ' 找到最后一列有内容的单元格 lastCol = dbSheet.Cells(matchRow, dbSheet.Columns.Count).End(xlToLeft).Column ' 设置源范围 Set sourceRange = dbSheet.Range(dbSheet.Cells(matchRow, 2), dbSheet.Cells(matchRow, lastCol)) ' 设置目标起始行（从当前单元格的下一格开始） destRow = targetCell.row + 1 ' 向下复制数据 For i = 1 To sourceRange.Cells.Count Me.Cells(destRow, targetCell.Column).Value = sourceRange.Cells(1, i).Value '如果包含下拉这个提示词，颜色标黄色提醒下拉 If InStr(Me.Cells(destRow, targetCell.Column).Value, "下拉") > 0 Then Me.Range("名称").Cells(destRow, 1).Interior.Color = RGB(255, 255, 0) End If If InStr(Me.Cells(destRow, targetCell.Column).Value, "钢钉") > 0 Or InStr(Me.Cells(destRow, targetCell.Column).Value, "销钉") > 0 Then Me.Range("材质").Cells(destRow, 1).Interior.Color = RGB(255, 255, 0) End If If InStr(Me.Cells(destRow, targetCell.Column).Value, "下拉") > 0 Then Me.Range("数量").Cells(destRow, 1).Interior.Color = xlNone ElseIf InStr(Me.Cells(destRow, targetCell.Column).Value, "筒节") > 0 Or _ InStr(Me.Cells(destRow, targetCell.Column).Value, "换热管") > 0 Or _ InStr(Me.Cells(destRow, targetCell.Column).Value, "集箱") > 0 Then Me.Range("数量").Cells(destRow, 1).Interior.Color = RGB(255, 255, 0) End If destRow = destRow + 1 Next i ' 检查A列单元格的值 currentRow = targetCell.row maxNumber = 0 isAllEmpty = True For j = currentRow To 3 Step -1 If Not IsEmpty(Me.Range("序号").Cells(j, 1).Value) Then isAllEmpty = False If IsNumeric(Me.Range("序号").Cells(j, 1).Value) Then If Me.Range("序号").Cells(j, 1).Value > maxNumber Then maxNumber = Me.Range("序号").Cells(j, 1).Value End If End If End If Next j ' 根据条件设置A列单元格的值 If isAllEmpty Then Me.Range("序号").Cells(currentRow, 1).Value = 1 Else ' 确保 maxNumber 是整数 Me.Range("序号").Cells(currentRow, 1).Value = Int(maxNumber) + 1 End If ' 对2步骤复制填充的单元格，依次填入当前单元格所在行A列得到的值加上.1,.2,.3这样的序列，填写在当前单元格向下一行朝下填充 seqNumber = Me.Cells(currentRow, 1).Value destRow = targetCell.row + 1 ' 重新设置目标起始行 For i = 1 To sourceRange.Cells.Count Me.Range("序号").Cells(destRow, 1).Value = seqNumber + i / 100 destRow = destRow + 1 Next i '增加一个汇总行 Me.Range("序号").Cells(destRow, 1).Value = seqNumber & "汇总" Me.Range("材料规格").Cells(destRow, 1).Value = Target.Value ' 在第2步骤，当复制填充单元格的时候，根据复制的内容，去sheet名称为“DB3产品类型对应材料类型”查找是否有符合内容的 Dim db3LastRow As Long db3LastRow = db3Sheet.Cells(db3Sheet.Rows.Count, 1).End(xlUp).row ' 动态计算最后一行 destRow = targetCell.row + 1 ' 重新设置目标起始行 For i = 1 To sourceRange.Cells.Count db3MatchRow = 0 For j = 2 To db3LastRow If db3Sheet.Cells(j, 1).Value = sourceRange.Cells(1, i).Value Then db3MatchRow = j Exit For End If Next j If db3MatchRow > 0 Then '如果能找到对应的，就把材料规格和类型放上去，其实后面做java可以完全不理，这里主要边做边看方便 Me.Range("材料规格").Cells(destRow, 1).Value = db3Sheet.Cells(db3MatchRow, 2).Value Me.Range("材料类型").Cells(destRow, 1).Value = db3Sheet.Cells(db3MatchRow, 5).Value End If destRow = destRow + 1 Next i ' 完成操作后清除下拉列表 targetCell.Validation.Delete ' 添加边框 Dim borderRange As Range Set borderRange = Me.Range(Me.Cells(targetCell.row + 1, 1), Me.Cells(destRow - 1, 10)) With borderRange.Borders .LineStyle = xlContinuous .Color = RGB(0, 0, 0) .weight = xlThin End With End If End If End If ' 新增功能：无论何时“名称”列的内容发生变化，都要执行以下代码 If Not Intersect(Target, Me.Range("名称").Rows("4:" & lastRow)) Is Nothing Then db3LastRow = db3Sheet.Cells(db3Sheet.Rows.Count, 1).End(xlUp).row ' 动态计算最后一行 For Each cell In Target db3MatchRow = 0 For j = 2 To db3LastRow If db3Sheet.Cells(j, 1).Value = cell.Value Then db3MatchRow = j Exit For End If Next j If db3MatchRow > 0 Then '如果能找到对应的，就把材料规格和类型放上去 Me.Range("材料规格").Cells(cell.row, 1).Value = db3Sheet.Cells(db3MatchRow, 2).Value Me.Range("材料类型").Cells(cell.row, 1).Value = db3Sheet.Cells(db3MatchRow, 5).Value End If Me.Range("名称").Cells(cell.row, 1).Interior.Color = xlNone Next cell End If '用材料类型来控制后续单元格的变色，提醒填写 If Not Intersect(Target, Me.Range("材料类型").Rows("4:" & lastRow)) Is Nothing Then If Target.Count = 1 Then ' 确保是单个单元格被选中 ' Dim changedCell As Range Set changedCell = Target(1) ' 检查第一列的单元格是否包含 ".",如果有就执行，这代表组件 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, ".") > 0 Then ' 检查D列、E列、F列、G列的值 Dim colsToCheck As Variant '目前是认为对于封头只要把4,5,6列填了就行，如果是其它，4,5,6,7都要变色。 If InStr(LCase(Me.Cells(changedCell.row, Me.Range("材料类型").Column).Value), "封头") > 0 Then Me.Range("材质").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("外径或宽度").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("壁厚").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("长度").Cells(changedCell.row, 1).Value = 0.05 '默认封头直边长50mm Me.Range("数量").Cells(changedCell.row, 1).Value = 2 '默认封头数量2 ElseIf InStr(LCase(Me.Cells(changedCell.row, Me.Range("材料类型").Column).Value), "管子") > 0 Then Me.Range("材质").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("外径或宽度").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("壁厚").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("长度").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) ElseIf InStr(LCase(Me.Cells(changedCell.row, Me.Range("材料类型").Column).Value), "板") > 0 Then Me.Range("材质").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("外径或宽度").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("壁厚").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("长度").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) ElseIf InStr(LCase(Me.Cells(changedCell.row, Me.Range("材料类型").Column).Value), "按件标准件") > 0 Then Me.Range("数量").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) ElseIf InStr(LCase(Me.Cells(changedCell.row, Me.Range("材料类型").Column).Value), "按吨加工件") > 0 Then Me.Range("材质").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) Me.Range("净重").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) End If End If End If End If ' 已完成，材质列变更的相应变动，调动单价，查找密度 If Not Intersect(Target, Me.Range("材质").Rows("4:" & lastRow)) Is Nothing Then If Target.Count = 1 Then ' 确保是单个单元格被选中 Set changedCell = Target Set targetSheet = Me ' 获取选中的值 selectedValue = changedCell.Value ' 查找“DB2材料及单价”表中对应的行 matchRow = 0 For i = 3 To db2Sheet.Cells(db2Sheet.Rows.Count, 1).End(xlUp).row If db2Sheet.Cells(i, 2).Value = selectedValue Then matchRow = i Exit For End If Next i ' 如果找到匹配的行，复制对应的C列值到L列 If matchRow > 0 Then Me.Range("密度").Cells(changedCell.row, 1).Value = db2Sheet.Cells(matchRow, 3).Value changedCell.Interior.ColorIndex = xlNone ' 清除背景颜色 End If '增加改变材料重新查价格 If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否输入了非空值 If Not IsEmpty(changedCell.Value) Then ' 清除背景颜色 changedCell.Interior.ColorIndex = xlNone cCellValue = Me.Range("材料规格").Cells(changedCell.row, 1).Value dCellValue = Me.Range("材质").Cells(changedCell.row, 1).Value fCellValue = Me.Range("壁厚").Cells(changedCell.row, 1).Value ' 确保 fCellValue 是数值类型 If Not IsNumeric(fCellValue) Then Debug.Print "fCellValue is not numeric: " & fCellValue GoTo NextIteration End If fCellValue = CDbl(fCellValue) ' 在 DB2 材料及单价表中查找符合条件的行并获取材料单价 matPrice = Find_Mat_Price(cCellValue, dCellValue, fCellValue, db2Sheet) ' 输出测试信息 If matPrice > 0 Then Debug.Print "Match found, Material Price: " & matPrice Me.Range("材料单价").Cells(changedCell.row, 1).Value = matPrice Else Me.Range("材料单价").Cells(changedCell.row, 1).Value = Empty End If Else ' 如果输入为空，设置背景颜色为黄色 changedCell.Interior.Color = RGB(255, 255, 0) End If End If End If End If ' 已完成，当外径宽度列发生变化，去核对修改体积 If Not Intersect(Target, Me.Range("外径或宽度").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("外径或宽度").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 And Not IsEmpty(changedCell.Value) Then ' 获取相关列的值 D = CDbl(Me.Range("外径或宽度").Cells(changedCell.row, 1).Value) T = CDbl(Me.Range("壁厚").Cells(changedCell.row, 1).Value) L = CDbl(Me.Range("长度").Cells(changedCell.row, 1).Value) name = Me.Range("材料类型").Cells(changedCell.row, 1).Value density = CDbl(Me.Range("密度").Cells(changedCell.row, 1).Value) ' 调用函数计算体积 volume = calculate_volume(D, T, L, name, density) ' 更新体积单元格的值 If Not IsEmpty(volume) Then Me.Range("体积").Cells(changedCell.row, 1).Value = volume Me.Range("体积").Cells(changedCell.row, 1).NumberFormat = "0.000" Else Me.Range("体积").Cells(changedCell.row, 1).Value = "" End If ' 调用函数计算外协加工费 ' Dim outsourceCost As Variant If InStr(name, "封头") > 0 Then outsourceCost = cap_out_cost(D, T, Me.Range("材质").Cells(changedCell.row, 1).Value, db7Sheet) ' 更新外协加工费单元格的值 If Not IsEmpty(outsourceCost) Then Me.Range("外协加工费").Cells(changedCell.row, 1).Value = outsourceCost * Me.Range("数量").Cells(changedCell.row, 1).Value Me.Range("外协加工费").Cells(changedCell.row, 1).NumberFormat = "0" Else Me.Range("外协加工费").Cells(changedCell.row, 1).Value = "" End If End If '外协加工计算到此结束 ' 调用函数计算拍片总数，拍片总数已在前面定义 If Me.Range("名称").Cells(changedCell.row, 1).Value = "筒节" Then totalShots = count_numbers_shot(Me.Range("外径或宽度").Cells(changedCell.row, 1).Value, _ Me.Range("长度").Cells(changedCell.row, 1).Value, _ Me.Range("数量").Cells(changedCell.row, 1).Value) ' 更新拍片总数单元格的值 Me.Range("拍片总数").Cells(changedCell.row, 1).Value = totalShots End If ' 结束调用函数计算拍片总数的代码段 ' 去除当前单元格颜色 changedCell.Interior.ColorIndex = xlNone Else Me.Range("体积").Cells(changedCell.row, 1).Value = Empty Me.Range("拍片总数").Cells(changedCell.row, 1).Value = Empty End If Next changedCell End If ' 已完成，壁厚变更，重新查找材料价格，并变更材料体积,壁厚相关项：材料价格，材料体积 If Not Intersect(Target, Me.Range("壁厚").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("壁厚").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否输入了非空值 If Not IsEmpty(changedCell.Value) Then ' 清除背景颜色 changedCell.Interior.ColorIndex = xlNone cCellValue = Me.Range("材料规格").Cells(changedCell.row, 1).Value dCellValue = Me.Range("材质").Cells(changedCell.row, 1).Value fCellValue = Me.Range("壁厚").Cells(changedCell.row, 1).Value ' 确保 fCellValue 是数值类型 If Not IsNumeric(fCellValue) Then Debug.Print "fCellValue is not numeric: " & fCellValue GoTo NextIteration End If fCellValue = CDbl(fCellValue) ' 在 DB2 材料及单价表中查找符合条件的行并获取材料单价 ' Dim matPrice As Double matPrice = Find_Mat_Price(cCellValue, dCellValue, fCellValue, db2Sheet) ' 输出测试信息 If matPrice > 0 Then Debug.Print "Match found, Material Price: " & matPrice Me.Range("材料单价").Cells(changedCell.row, 1).Value = matPrice Else Me.Range("材料单价").Cells(changedCell.row, 1).Value = Empty End If Else ' 如果输入为空，设置背景颜色为黄色 changedCell.Interior.Color = RGB(255, 255, 0) End If ' '增加壁厚变动，重新计算体积 D = CDbl(Me.Range("外径或宽度").Cells(changedCell.row, 1).Value) T = CDbl(Me.Range("壁厚").Cells(changedCell.row, 1).Value) L = CDbl(Me.Range("长度").Cells(changedCell.row, 1).Value) name = Me.Range("材料类型").Cells(changedCell.row, 1).Value density = CDbl(Me.Range("密度").Cells(changedCell.row, 1).Value) ' 调用函数计算体积 volume = calculate_volume(D, T, L, name, density) ' 更新体积单元格的值 If Not IsEmpty(volume) Then Me.Range("体积").Cells(changedCell.row, 1).Value = volume Me.Range("体积").Cells(changedCell.row, 1).NumberFormat = "0.000" Else Me.Range("体积").Cells(changedCell.row, 1).Value = "" End If ' 调用函数计算外协加工费 ' Dim outsourceCost As Variant If InStr(name, "封头") > 0 Then outsourceCost = cap_out_cost(D, T, Me.Range("材质").Cells(changedCell.row, 1).Value, db7Sheet) ' 更新外协加工费单元格的值 If Not IsEmpty(outsourceCost) Then Me.Range("外协加工费").Cells(changedCell.row, 1).Value = outsourceCost * Me.Range("数量").Cells(changedCell.row, 1).Value Me.Range("外协加工费").Cells(changedCell.row, 1).NumberFormat = "0" Else Me.Range("外协加工费").Cells(changedCell.row, 1).Value = "" End If End If '外协加工计算到此结束 ' 去除当前单元格颜色 changedCell.Interior.ColorIndex = xlNone Else Me.Range("体积").Cells(changedCell.row, 1).Value = Empty End If NextIteration: Next changedCell End If ' 已完成，当长度列发生变化，去核对修改体积 If Not Intersect(Target, Me.Range("长度").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("长度").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 And Not IsEmpty(changedCell.Value) Then ' 获取相关列的值 D = CDbl(Me.Range("外径或宽度").Cells(changedCell.row, 1).Value) T = CDbl(Me.Range("壁厚").Cells(changedCell.row, 1).Value) L = CDbl(Me.Range("长度").Cells(changedCell.row, 1).Value) name = Me.Range("材料类型").Cells(changedCell.row, 1).Value density = CDbl(Me.Range("密度").Cells(changedCell.row, 1).Value) ' 调用函数计算体积 volume = calculate_volume(D, T, L, name, density) ' 更新体积单元格的值 If Not IsEmpty(volume) Then Me.Range("体积").Cells(changedCell.row, 1).Value = volume Me.Range("体积").Cells(changedCell.row, 1).NumberFormat = "0.000" Else Me.Range("体积").Cells(changedCell.row, 1).Value = "" End If ' 去除当前单元格颜色 changedCell.Interior.ColorIndex = xlNone ' 调用函数计算拍片总数，拍片总数已在前面定义 If Me.Range("名称").Cells(changedCell.row, 1).Value = "筒节" Then totalShots = count_numbers_shot(Me.Range("外径或宽度").Cells(changedCell.row, 1).Value, _ Me.Range("长度").Cells(changedCell.row, 1).Value, _ Me.Range("数量").Cells(changedCell.row, 1).Value) ' 更新拍片总数单元格的值 Me.Range("拍片总数").Cells(changedCell.row, 1).Value = totalShots Me.Range("拍片总数").Cells(changedCell.row, 1).NumberFormat = "0" End If ' 结束调用函数计算拍片总数的代码段 ' 新增功能：当名称列包含"光管换热管"或“蛇形换热管”，计算焊口数 If InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "光管换热管") > 0 Or _ InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "蛇形换热管") > 0 Then ' 检查“长度”列是否为数值且大于0 If IsNumeric(Me.Range("长度").Cells(changedCell.row, 1).Value) And _ Me.Range("长度").Cells(changedCell.row, 1).Value > 0 Then length = Me.Range("长度").Cells(changedCell.row, 1).Value Else length = -1 ' 标记“长度”列不符合条件 End If ' 检查“数量”列是否为数值且大于0 If IsNumeric(Me.Range("数量").Cells(changedCell.row, 1).Value) And _ Me.Range("数量").Cells(changedCell.row, 1).Value > 0 Then quantity = Me.Range("数量").Cells(changedCell.row, 1).Value Else quantity = 1 ' 标记“数量”列不符合条件 End If ' 如果“长度”和“数量”列都符合条件，则计算焊口数 If length > 0 And quantity > 0 Then ' 计算焊口数并填写到“焊口数”列 Me.Range("焊口数").Cells(changedCell.row, 1).Value = (Int(length / 11) + 1) * quantity Me.Range("焊口数").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("拍片总数").Cells(changedCell.row, 1).Value = (Int(length / 11) + 1) * quantity ' Me.Range("拍片总数").Cells(changedCell.row, 1).NumberFormat = "0" Else ' 如果任一列不符合条件，则将“焊口数”列的值设置为空 Me.Range("焊口数").Cells(changedCell.row, 1).Value = "" Me.Range("拍片总数").Cells(changedCell.row, 1).Value = "" End If End If Else Me.Range("体积").Cells(changedCell.row, 1).Value = Empty End If Next changedCell End If ' 已完成，当体积列发生变化，去核对修改净重 If Not Intersect(Target, Me.Range("体积").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("体积").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查体积列是否为空 If IsEmpty(changedCell.Value) Then ' 如果体积列为空，则将净重列也设置为空 Me.Range("净重").Cells(changedCell.row, 1).Value = Empty Else ' 获取体积值 volume = CDbl(changedCell.Value) ' 获取数量值 quantity = Me.Range("数量").Cells(changedCell.row, 1).Value ' 判断数量是否为数值且大于1 If IsNumeric(quantity) And quantity > 1 Then weight = CDbl(quantity) * volume * Me.Range("密度").Cells(changedCell.row, 1).Value ElseIf IsEmpty(quantity) Then weight = volume * Me.Range("密度").Cells(changedCell.row, 1).Value ' Else ' weight = volume ' 如果数量不符合条件，净重仍为体积值 End If ' 更新净重单元格的值 Me.Range("净重").Cells(changedCell.row, 1).Value = weight Me.Range("净重").Cells(changedCell.row, 1).NumberFormat = "0.000" ' 去除当前单元格颜色 changedCell.Interior.ColorIndex = xlNone End If End If Next changedCell End If ' 已完成，数量发生变化，修改净重（这里是乘以数量的） If Not Intersect(Target, Me.Range("数量").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("数量").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 Then If IsEmpty(changedCell.Value) Then ' 如果体积列为空，则将净重列也设置为空 Me.Range("净重").Cells(changedCell.row, 1).Value = Empty Else ' 获取体积值 volume = CDbl(Me.Range("体积").Cells(changedCell.row, 1).Value) ' 获取数量值 quantity = Me.Range("数量").Cells(changedCell.row, 1).Value ' 判断数量是否为数值且大于1 If IsNumeric(quantity) And quantity > 0 Then weight = CDbl(quantity) * volume * Me.Range("密度").Cells(changedCell.row, 1).Value ElseIf IsEmpty(quantity) Then weight = volume * Me.Range("密度").Cells(changedCell.row, 1).Value End If ' 更新净重单元格的值 If Me.Range("材料类型").Cells(changedCell.row, 1).Value = "按件标准件" Then Me.Range("净重").Cells(changedCell.row, 1).Value = "" Else Me.Range("净重").Cells(changedCell.row, 1).Value = weight Me.Range("净重").Cells(changedCell.row, 1).NumberFormat = "0.000" End If ' 调用函数计算拍片总数，拍片总数已在前面定义 If Me.Range("名称").Cells(changedCell.row, 1).Value = "筒节" Then totalShots = count_numbers_shot(Me.Range("外径或宽度").Cells(changedCell.row, 1).Value, _ Me.Range("长度").Cells(changedCell.row, 1).Value, _ Me.Range("数量").Cells(changedCell.row, 1).Value) ' 更新拍片总数单元格的值 Me.Range("拍片总数").Cells(changedCell.row, 1).Value = totalShots Me.Range("拍片总数").Cells(changedCell.row, 1).NumberFormat = "0" End If ' 结束调用函数计算拍片总数的代码段 '计算光管和蛇形换热管的焊口数 If InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "光管换热管") > 0 Or _ InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "蛇形换热管") > 0 Then ' 获取“长度”和“数量”列的值 ' Dim length As Double ' Dim quantity As Double ' 检查“长度”列是否为数值且大于0 If IsNumeric(Me.Range("长度").Cells(changedCell.row, 1).Value) And _ Me.Range("长度").Cells(changedCell.row, 1).Value > 0 Then length = Me.Range("长度").Cells(changedCell.row, 1).Value Else length = -1 ' 标记“长度”列不符合条件 End If ' 检查“数量”列是否为数值且大于0 If IsNumeric(Me.Range("数量").Cells(changedCell.row, 1).Value) And _ Me.Range("数量").Cells(changedCell.row, 1).Value > 0 Then quantity = Me.Range("数量").Cells(changedCell.row, 1).Value Else quantity = 1 ' 标记“数量”列不符合条件 End If ' 如果“长度”和“数量”列都符合条件，则计算焊口数 If length > 0 And quantity > 0 Then ' 计算焊口数并填写到“焊口数”列 Me.Range("焊口数").Cells(changedCell.row, 1).Value = (Int(length / 11) + 1) * quantity Me.Range("焊口数").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("拍片总数").Cells(changedCell.row, 1).Value = (Int(length / 11) + 1) * quantity ' Me.Range("拍片总数").Cells(changedCell.row, 1).NumberFormat = "0" Else ' 如果任一列不符合条件，则将“焊口数”列的值设置为空 Me.Range("焊口数").Cells(changedCell.row, 1).Value = "" Me.Range("拍片总数").Cells(changedCell.row, 1).Value = "" End If End If '计算换热管加弯头的焊口数 If InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "换热管") > 0 And _ InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "弯头") > 0 Then ' 检查“数量”列是否为数值且大于0 If IsNumeric(Me.Range("数量").Cells(changedCell.row, 1).Value) And _ Me.Range("数量").Cells(changedCell.row, 1).Value > 0 Then Me.Range("焊口数").Cells(changedCell.row, 1).Value = Me.Range("数量").Cells(changedCell.row, 1).Value * 2 Me.Range("焊口数").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("拍片总数").Cells(changedCell.row, 1).Value = Me.Range("数量").Cells(changedCell.row, 1).Value * 2 ' Me.Range("拍片总数").Cells(changedCell.row, 1).NumberFormat = "0" Else Me.Range("焊口数").Cells(changedCell.row, 1).Value = "" ' 标记“数量”列不符合条件 Me.Range("拍片总数").Cells(changedCell.row, 1).Value = "" End If End If ' 检查当前行的“材料类型”单元格值是否为“按件标准件”，调用材料单价 If Me.Range("材料类型").Cells(changedCell.row, 1).Value = "按件标准件" Then Dim nameValue As String Dim foundCell As Range Dim materialPrice As Variant ' Me.Range("净重").Cells(changedCell.row, 1).Value = "" nameValue = Me.Range("名称").Cells(changedCell.row, 1).Value ' 获取当前行的“名称”单元格值 ' 在db12sheet的第二行开始往下找第2列单元格的值是否有相同的 Set foundCell = db12Sheet.Range("B2:B" & db12Sheet.Cells(Rows.Count, 2).End(xlUp).row).Find(What:=nameValue, LookIn:=xlValues, LookAt:=xlWhole) If Not foundCell Is Nothing Then ' 如果找到，返回找到行第三列的单元格的值到当前行的命名为“材料单价”的单元格 materialPrice = foundCell.Offset(0, 1).Value Me.Range("材料单价").Cells(changedCell.row, 1).Value = materialPrice Me.Range("材料费").Cells(changedCell.row, 1).Value = materialPrice * Me.Range("数量").Cells(changedCell.row, 1).Value End If End If '检查如果名称含有钢钉，根据规格和材质到DB11钢钉重量及价格查找符合的 If InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "钢钉") > 0 Then ' Dim nameValue As String ' Dim materialValue As String ' Dim foundCell As Range ' Dim materialPrice As Variant ' 获取当前行的“名称”和“材质”单元格值 nameValue = Me.Range("名称").Cells(changedCell.row, 1).Value materialValue = Me.Range("材质").Cells(changedCell.row, 1).Value ' 在db11Sheet的第三行开始往下找第2列单元格的值是否有相同的“名称” Set foundCell = Nothing For i = 3 To db11Sheet.Cells(db11Sheet.Rows.Count, 2).End(xlUp).row If db11Sheet.Cells(i, 2).Value = nameValue And db11Sheet.Cells(i, 3).Value = materialValue Then Set foundCell = db11Sheet.Cells(i, 2) Exit For End If Next i If Not foundCell Is Nothing Then ' 如果找到，返回找到行第5列的单元格的值到当前行的命名为“材料单价”的单元格 materialPrice = foundCell.Offset(0, 3).Value ' 第5列相对于第2列的偏移量为3 Me.Range("材料费").Cells(changedCell.row, 1).Value = materialPrice * Me.Range("数量").Cells(changedCell.row, 1).Value Me.Range("净重").Cells(changedCell.row, 1).Value = foundCell.Offset(0, 2).Value * Me.Range("数量").Cells(changedCell.row, 1).Value / 1000 Me.Range("焊口人工费").Cells(changedCell.row, 1).Value = foundCell.Offset(0, 4).Value * Me.Range("数量").Cells(changedCell.row, 1).Value ' Me.Range("材料费").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("焊口人工费").Cells(changedCell.row, 1).NumberFormat = "0" End If End If ' 去除当前单元格颜色 changedCell.Interior.ColorIndex = xlNone End If End If Next changedCell End If ' 已完成，当列“焊口数”变化的时候，对应要求填写焊口单价，计算焊口人工费，还要考虑加个拍片费用，后面还要做个汇总 If Not Intersect(Target, Me.Range("焊口数").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("焊口数").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 And InStr(LCase(Me.Range("序号").Cells(changedCell.row, 1).Value), ".") > 0 Then ' 当I列数值变化且大于0时，要求填写比例 If IsNumeric(changedCell.Value) And changedCell.Value > 0 Then ' 获取当前行的外径或宽度和壁厚的值 Dim diameter As Double Dim thickness As Double Dim material As String diameter = CDbl(Me.Range("外径或宽度").Cells(changedCell.row, 1).Value) thickness = CDbl(Me.Range("壁厚").Cells(changedCell.row, 1).Value) material = Me.Range("材质").Cells(changedCell.row, 1).Value Me.Range("拍片总数").Cells(changedCell.row, 1).Value = Me.Range("焊口数").Cells(changedCell.row, 1).Value ' 在db10sheet中查找匹配的行 For i = 4 To db10Sheet.Cells(db10Sheet.Rows.Count, 1).End(xlUp).row If diameter = CDbl(db10Sheet.Cells(i, 3).Value) And thickness = CDbl(db10Sheet.Cells(i, 4).Value) Then matchRow = i Exit For End If Next i ' 根据材质返回相应的焊口单价 If matchRow > 0 Then If InStr(material, "Cr") > 0 Then Me.Range("焊口单价").Cells(changedCell.row, 1).Value = db10Sheet.Cells(matchRow, 7).Value ElseIf InStr(material, "30") > 0 Or InStr(material, "31") > 0 Then Me.Range("焊口单价").Cells(changedCell.row, 1).Value = db10Sheet.Cells(matchRow, 8).Value ElseIf Not IsEmpty(material) Then Me.Range("焊口单价").Cells(changedCell.row, 1).Value = db10Sheet.Cells(matchRow, 6).Value Else Me.Range("焊口单价").Cells(changedCell.row, 1).Value = "" End If Else Me.Range("焊口单价").Cells(changedCell.row, 1).Value = "" End If If Me.Range("焊口单价").Cells(changedCell.row, 1).Value = "" Then Me.Range("焊口人工费").Cells(changedCell.row, 1).Value = "" Else Me.Range("焊口人工费").Cells(changedCell.row, 1).Value = Me.Range("焊口数").Cells(changedCell.row, 1).Value * Me.Range("焊口单价").Cells(changedCell.row, 1).Value End If End If End If Next changedCell End If '对焊口人工费进行归总。 If Not Intersect(Target, Me.Range("焊口人工费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("焊口人工费").Rows("4:" & Me.Rows.Count)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否是分项行（包含 "."） If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, ".") > 0 Then ' 向上查找第一个不含 "." 的行 upperRow = changedCell.row Do While upperRow > 1 And InStr(Me.Cells(upperRow, 1).Value, ".") > 0 upperRow = upperRow - 1 Loop ' 向下查找第一个不含 "." 的行 lowerRow = changedCell.row Do While lowerRow <= Me.Rows.Count And InStr(Me.Cells(lowerRow, 1).Value, ".") > 0 lowerRow = lowerRow + 1 Loop ' 检查这之间的行的焊口人工费单元格是否有数值且大于0 totalValue = 0 ' Dim allEmpty As Boolean allEmpty = True For checkRow = upperRow + 1 To lowerRow - 1 If IsNumeric(Me.Cells(checkRow, Me.Range("焊口人工费").Column).Value) Then cellValue = CDbl(Me.Cells(checkRow, Me.Range("焊口人工费").Column).Value) If cellValue > 0 Then totalValue = totalValue + cellValue allEmpty = False End If End If Next checkRow ' 如果总和大于0，将总和填写到汇总行的焊口人工费单元格 If totalValue > 0 Then Me.Cells(lowerRow, Me.Range("焊口人工费").Column).Value = totalValue Me.Cells(lowerRow, Me.Range("焊口人工费").Column).Interior.Color = RGB(0, 255, 0) Me.Cells(lowerRow, Me.Range("焊口人工费").Column).NumberFormat = "0" ElseIf allEmpty Then Me.Cells(lowerRow, Me.Range("焊口人工费").Column).Value = "" Me.Cells(lowerRow, Me.Range("焊口人工费").Column).Interior.ColorIndex = xlNone End If End If ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then '综合车间管理费 weldingCost = 0 cuttingPaintingCost = 0 totalShopManagementCost = 0 man_weld = 0 ' 检查装焊人工费 If IsNumeric(Me.Range("装焊人工费").Cells(changedCell.row, 1).Value) Then weldingCost = CDbl(Me.Range("装焊人工费").Cells(changedCell.row, 1).Value) End If ' 检查下料油漆人工费 If IsNumeric(Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value) Then cuttingPaintingCost = CDbl(Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value) End If ' 检查焊口人工费 If IsNumeric(Me.Range("焊口人工费").Cells(changedCell.row, 1).Value) Then man_weld = CDbl(Me.Range("焊口人工费").Cells(changedCell.row, 1).Value) End If ' 计算总和 totalShopManagementCost = weldingCost + cuttingPaintingCost + man_weld ' 将总和填写到当前行的车间管理费单元格 Me.Range("车间管理费").Cells(changedCell.row, 1).Value = totalShopManagementCost * ThisWorkbook.Sheets("DB8车间管理费系数").Cells(3, 1).Value Me.Range("车间管理费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("车间管理费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ' 调用函数计算制造费 totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If ' 已完成，当列“拍片总数”变化的时候，对应要求填写焊口单价，计算焊口人工费，还要考虑加个拍片费用，后面还要做个汇总 If Not Intersect(Target, Me.Range("拍片总数").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("拍片总数").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 And InStr(LCase(Me.Range("序号").Cells(changedCell.row, 1).Value), ".") > 0 Then ' 当I列数值变化且大于0时，要求填写比例 If IsNumeric(changedCell.Value) And changedCell.Value > 0 Then ' 当前行J列单元格变黄色 Me.Range("拍片比例").Cells(changedCell.row, 1).Interior.Color = RGB(255, 255, 0) ' 获取当前行的壁厚值 thickness = Me.Range("壁厚").Cells(changedCell.row, 1).Value ' 在DB5无损检测价格表中查找匹配的行 matchRow = 0 For i = 3 To db5Sheet.Cells(db5Sheet.Rows.Count, 1).End(xlUp).row If thickness > db5Sheet.Cells(i, 2).Value And thickness <= db5Sheet.Cells(i, 3).Value Then matchRow = i Exit For End If Next i ' 如果找到匹配的行，将第四列的数值填写到当前行的“拍片单价”单元格 If matchRow > 0 Then Me.Range("拍片单价").Cells(changedCell.row, 1).Value = db5Sheet.Cells(matchRow, 4).Value Else Me.Range("拍片单价").Cells(changedCell.row, 1).Value = "" End If '重新计算拍片费用 If IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.5" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.5) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.5 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.2" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.2) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.2 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.1" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.1) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.1 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.05" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.05) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.05 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "1" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 1) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 1 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.0" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = "" Me.Range("无损检测费").Cells(changedCell.row, 1).Value = "" End If End If End If Next changedCell End If ' 已完成，拍片比例变动且有数值，改动拍片实际数量，计算无损检测费用 If Not Intersect(Target, Me.Range("拍片比例").Rows("4:" & lastRow)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("拍片比例").Rows("4:" & lastRow)) If changedCell.Count = 1 And changedCell.row > 3 And InStr(LCase(Me.Range("序号").Cells(changedCell.row, 1).Value), ".") > 0 Then ' 获取当前行的 I 列数值 Dim baseValue As Double If IsNumeric(Me.Range("拍片总数").Cells(changedCell.row, 1).Value) Then baseValue = Me.Range("拍片总数").Cells(changedCell.row, 1).Value Else baseValue = 0 End If ' 获取当前行的 J 列下拉列表值，并转换为数值 Dim discount As Double If IsNumeric(Replace(changedCell.Value, "%", "")) Then discount = CDbl(Replace(changedCell.Value, "%", "")) / 100 Else discount = 1 ' 默认为 100% End If ' 检查第27列是否为数值且大于0 If IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.5" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.5) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.5 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.2" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.2) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.2 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.1" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.1) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.1 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "0.05" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 0.05) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 0.05 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf IsNumeric(Me.Range("拍片单价").Cells(changedCell.row, 1).Value) And Me.Range("拍片单价").Cells(changedCell.row, 1).Value > 0 And Me.Range("拍片比例").Cells(changedCell.row, 1).Value = "1" Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = 2 * Round(Me.Range("拍片总数").Cells(changedCell.row, 1).Value * 1) Me.Range("无损检测费").Cells(changedCell.row, 1).Value = 2 * Me.Range("拍片总数").Cells(changedCell.row, 1).Value * Me.Range("拍片单价").Cells(changedCell.row, 1).Value * 1 Me.Range("实际拍片数量").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("无损检测费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ElseIf Me.Range("拍片比例").Cells(changedCell.row, 1).Value = 0 Then Me.Range("实际拍片数量").Cells(changedCell.row, 1).Value = "" Me.Range("无损检测费").Cells(changedCell.row, 1).Value = "" End If End If Me.Range("拍片比例").Cells(changedCell.row, 1).Interior.Color = xlNone Next changedCell End If '对无损检测费进行归总。 If Not Intersect(Target, Me.Range("无损检测费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("无损检测费").Rows("4:" & Me.Rows.Count)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否是分项行（包含 "."） If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, ".") > 0 Then ' 向上查找第一个不含 "." 的行 upperRow = changedCell.row Do While upperRow > 1 And InStr(Me.Cells(upperRow, 1).Value, ".") > 0 upperRow = upperRow - 1 Loop ' 向下查找第一个不含 "." 的行 lowerRow = changedCell.row Do While lowerRow <= Me.Rows.Count And InStr(Me.Cells(lowerRow, 1).Value, ".") > 0 lowerRow = lowerRow + 1 Loop ' 检查这之间的行的无损检测费单元格是否有数值且大于0 totalValue = 0 For checkRow = upperRow + 1 To lowerRow - 1 If IsNumeric(Me.Cells(checkRow, Me.Range("无损检测费").Column).Value) Then cellValue = CDbl(Me.Cells(checkRow, Me.Range("无损检测费").Column).Value) If cellValue > 0 Then totalValue = totalValue + cellValue End If End If Next checkRow ' 如果总和大于0，将总和填写到汇总行的无损检测费单元格 If totalValue > 0 Then Me.Cells(lowerRow, Me.Range("无损检测费").Column).Value = totalValue Me.Cells(lowerRow, Me.Range("无损检测费").Column).Interior.Color = RGB(0, 255, 0) Me.Cells(lowerRow, Me.Range("无损检测费").Column).NumberFormat = "0" End If End If ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算制造费 ' Dim totalManufacturingCost As Double totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If '对外协加工费进行归总。 If Not Intersect(Target, Me.Range("外协加工费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("外协加工费").Rows("4:" & Me.Rows.Count)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否是分项行（包含 "."） If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, ".") > 0 Then ' 向上查找第一个不含 "." 的行 upperRow = changedCell.row Do While upperRow > 1 And InStr(Me.Cells(upperRow, 1).Value, ".") > 0 upperRow = upperRow - 1 Loop ' 向下查找第一个不含 "." 的行 lowerRow = changedCell.row Do While lowerRow <= Me.Rows.Count And InStr(Me.Cells(lowerRow, 1).Value, ".") > 0 lowerRow = lowerRow + 1 Loop ' 检查这之间的行的外协加工费单元格是否有数值且大于0 totalValue = 0 For checkRow = upperRow + 1 To lowerRow - 1 If IsNumeric(Me.Cells(checkRow, Me.Range("外协加工费").Column).Value) Then cellValue = CDbl(Me.Cells(checkRow, Me.Range("外协加工费").Column).Value) If cellValue > 0 Then totalValue = totalValue + cellValue End If End If Next checkRow ' 如果总和大于0，将总和填写到汇总行的外协加工费单元格 If totalValue > 0 Then Me.Cells(lowerRow, Me.Range("外协加工费").Column).Value = totalValue Me.Cells(lowerRow, Me.Range("外协加工费").Column).Interior.Color = RGB(0, 255, 0) Me.Cells(lowerRow, Me.Range("外协加工费").Column).NumberFormat = "0" End If End If ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算制造费 ' Dim totalManufacturingCost As Double totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If '对热处理费进行归总。先关掉用新的试试 If Not Intersect(Target, Me.Range("热处理费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("热处理费").Rows("4:" & Me.Rows.Count)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否是分项行（包含 "."） If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, ".") > 0 Then ' 向上查找第一个不含 "." 的行 upperRow = changedCell.row Do While upperRow > 1 And InStr(Me.Cells(upperRow, 1).Value, ".") > 0 upperRow = upperRow - 1 Loop ' 向下查找第一个不含 "." 的行 lowerRow = changedCell.row Do While lowerRow <= Me.Rows.Count And InStr(Me.Cells(lowerRow, 1).Value, ".") > 0 lowerRow = lowerRow + 1 Loop ' 检查这之间的行的热处理费单元格是否有数值且大于0 totalValue = 0 allEmpty = True For checkRow = upperRow + 1 To lowerRow - 1 If IsNumeric(Me.Cells(checkRow, Me.Range("热处理费").Column).Value) Then cellValue = CDbl(Me.Cells(checkRow, Me.Range("热处理费").Column).Value) If cellValue > 0 Then totalValue = totalValue + cellValue allEmpty = False End If End If Next checkRow ' 如果总和大于0，将总和填写到汇总行的热处理费单元格 If totalValue > 0 Then Me.Cells(lowerRow, Me.Range("热处理费").Column).Value = totalValue Me.Cells(lowerRow, Me.Range("热处理费").Column).Interior.Color = RGB(0, 255, 0) Me.Cells(lowerRow, Me.Range("热处理费").Column).NumberFormat = "0" ElseIf allEmpty Then Me.Cells(lowerRow, Me.Range("热处理费").Column).Value = "" Me.Cells(lowerRow, Me.Range("热处理费").Column).Interior.ColorIndex = xlNone End If End If ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算制造费 totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If '装焊人工费变动后，对制作费进行归总。 If Not Intersect(Target, Me.Range("装焊人工费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("装焊人工费").Rows("4:" & Me.Rows.Count)) ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算制造费 totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If '综合车间管理费 weldingCost = 0 cuttingPaintingCost = 0 totalShopManagementCost = 0 man_weld = 0 ' 检查装焊人工费 If IsNumeric(Me.Range("装焊人工费").Cells(changedCell.row, 1).Value) Then weldingCost = CDbl(Me.Range("装焊人工费").Cells(changedCell.row, 1).Value) End If ' 检查下料油漆人工费 If IsNumeric(Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value) Then cuttingPaintingCost = CDbl(Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value) End If ' 检查焊口人工费 If IsNumeric(Me.Range("焊口人工费").Cells(changedCell.row, 1).Value) Then man_weld = CDbl(Me.Range("焊口人工费").Cells(changedCell.row, 1).Value) End If ' 计算总和 totalShopManagementCost = weldingCost + cuttingPaintingCost + man_weld ' 将总和填写到当前行的车间管理费单元格 Me.Range("车间管理费").Cells(changedCell.row, 1).Value = totalShopManagementCost * ThisWorkbook.Sheets("DB8车间管理费系数").Cells(3, 1).Value Me.Range("车间管理费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("车间管理费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) Next changedCell End If '下料油漆人工费变动后，对制作费进行归总。 If Not Intersect(Target, Me.Range("下料油漆人工费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("下料油漆人工费").Rows("4:" & Me.Rows.Count)) ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算制造费 totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If '综合车间管理费 weldingCost = 0 cuttingPaintingCost = 0 totalShopManagementCost = 0 man_weld = 0 ' 检查装焊人工费 If IsNumeric(Me.Range("装焊人工费").Cells(changedCell.row, 1).Value) Then weldingCost = CDbl(Me.Range("装焊人工费").Cells(changedCell.row, 1).Value) End If ' 检查下料油漆人工费 If IsNumeric(Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value) Then cuttingPaintingCost = CDbl(Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value) End If ' 检查焊口人工费 If IsNumeric(Me.Range("焊口人工费").Cells(changedCell.row, 1).Value) Then man_weld = CDbl(Me.Range("焊口人工费").Cells(changedCell.row, 1).Value) End If ' 计算总和 totalShopManagementCost = weldingCost + cuttingPaintingCost + man_weld ' 将总和填写到当前行的车间管理费单元格 Me.Range("车间管理费").Cells(changedCell.row, 1).Value = totalShopManagementCost * ThisWorkbook.Sheets("DB8车间管理费系数").Cells(3, 1).Value Me.Range("车间管理费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("车间管理费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) Next changedCell End If '辅材费变动后，对制作费进行归总。 If Not Intersect(Target, Me.Range("辅材费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("辅材费").Rows("4:" & Me.Rows.Count)) ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算制造费 totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If Next changedCell End If '机加工费变动后，对制作费进行归总。 If Not Intersect(Target, Me.Range("机加工费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("机加工费").Rows("4:" & Me.Rows.Count)) ' 检查是否是汇总行，变更后汇总到制造费 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算制造费 totalManufacturingCost = production_cost(changedCell.row, Me) ' 将总和填写到当前行的制造费单元格 Me.Range("制作费").Cells(changedCell.row, 1).Value = totalManufacturingCost Me.Range("制作费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("制作费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If Next changedCell End If ' 当设计重量发生变动，连锁变更估重和材料费用】材料系数到数据库的表里取值，由于设计重量关联到材料成本，加工成本，是重中之重 If Not Intersect(Target, Me.Range("净重").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("净重").Rows("4:" & Me.Rows.Count)) '对于分项的净重变动，调取材料系数，计算毛重，计算材料费 If changedCell.Count = 1 And changedCell.row > 3 And InStr(LCase(Me.Range("序号").Cells(changedCell.row, 1).Value), ".") > 0 Then matchRow = 0 For i = 3 To db3Sheet.Cells(db3Sheet.Rows.Count, 1).End(xlUp).row If db3Sheet.Cells(i, 1).Value = Me.Range("名称").Cells(changedCell.row, 1).Value Then matchRow = i Exit For End If Next i ' 如果找到匹配的行，将第四列的值返回到当前行的毛重单元格 If matchRow > 0 Then Me.Range("毛重").Cells(changedCell.row, 1).Value = db3Sheet.Cells(matchRow, 4).Value * Me.Range("净重").Cells(changedCell.row, 1).Value Me.Range("毛重").Cells(changedCell.row, 1).NumberFormat = "0.000" '对要集成计算人工算的重量进行提取，否则不提取 If db3Sheet.Cells(matchRow, 3).Value = "是" Then Me.Cells(changedCell.row, Me.Range("集成计算人工费的重量").Column).Value = Me.Range("净重").Cells(changedCell.row, 1).Value Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).NumberFormat = "0.000" Else Me.Cells(changedCell.row, Me.Range("集成计算人工费的重量").Column).Value = "" End If Else Me.Range("毛重").Cells(changedCell.row, 1).Value = "" End If ' 得到材料费，用估算重量乘以材料单价 If InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "钢钉") = 0 And InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "销钉") = 0 Then Me.Range("材料费").Cells(changedCell.row, 1).Value = db3Sheet.Cells(matchRow, 4).Value * Me.Range("净重").Cells(changedCell.row, 1).Value * Me.Range("材料单价").Cells(changedCell.row, 1).Value Me.Range("材料费").Cells(changedCell.row, 1).NumberFormat = "0" End If ' 向上查找第一个不含 "." 的行 ' 向上查找第一个不含 "." 的行 upperRow = changedCell.row Do While upperRow > 1 And InStr(LCase(Me.Cells(upperRow, 1).Value), ".") > 0 upperRow = upperRow - 1 Loop ' 向下查找第一个不含 "." 的行 lowerRow = changedCell.row Do While lowerRow <= Me.Rows.Count And InStr(LCase(Me.Cells(lowerRow, 1).Value), ".") > 0 lowerRow = lowerRow + 1 Loop ' 检查这之间的行的净重单元格是否有数值 totalValue = 0 For checkRow = upperRow + 1 To lowerRow - 1 If IsNumeric(Me.Cells(checkRow, Me.Range("净重").Column).Value) Then totalValue = totalValue + Me.Cells(checkRow, Me.Range("净重").Column).Value Else totalValue = -1 ' 如果有空值或非数值，设置为-1 Exit For End If Next checkRow ' 如果所有行都有数值，将总和填写到汇总行的净重单元格 If totalValue >= 0 Then Me.Cells(lowerRow, Me.Range("净重").Column).Value = totalValue Me.Cells(lowerRow, Me.Range("净重").Column).NumberFormat = "0.000" Me.Cells(lowerRow, Me.Range("净重").Column).Interior.Color = RGB(0, 255, 0) End If '目前不成功呢 '找出需要热处理的，并提供单价和总价 If IsNumeric(Me.Range("净重").Cells(changedCell.row, 1).Value) And Me.Range("净重").Cells(changedCell.row, 1).Value > 0 Then ' 获取材质和壁厚的值 material = Me.Range("材质").Cells(changedCell.row, 1).Value thickness = CDbl(Me.Range("壁厚").Cells(changedCell.row, 1).Value) ' 在DB6热处理要求表中查找对应的热处理单价 ' Dim db6MatchRow As Long ' db6MatchRow = 0 For i = 3 To db6Sheet.Cells(db6Sheet.Rows.Count, 1).End(xlUp).row If db6Sheet.Cells(i, 1).Value = material And thickness > CDbl(db6Sheet.Cells(i, 2).Value) Then db6MatchRow = i Exit For End If Next i ' 如果找到匹配的行，将第三列的值返回到当前行的热处理单价单元格 If db6MatchRow > 0 Then Me.Range("热处理单价").Cells(changedCell.row, 1).Value = db6Sheet.Cells(db6MatchRow, 3).Value Me.Range("热处理单价").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("热处理费").Cells(changedCell.row, 1).Value = db6Sheet.Cells(db6MatchRow, 3).Value * Me.Range("净重").Cells(changedCell.row, 1).Value Me.Range("热处理费").Cells(changedCell.row, 1).NumberFormat = "0" Else Me.Range("热处理单价").Cells(changedCell.row, 1).Value = "" Me.Range("热处理费").Cells(changedCell.row, 1).Value = "" End If End If '热处理单元处理结束 '如果是集箱，加4000元每吨到焊口人工费，如果是钢钉，算出个数乘以每个的加工费 If Me.Range("净重").Cells(changedCell.row, 1).Value > 0 And InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "集箱") > 0 Then Me.Range("焊口人工费").Cells(changedCell.row, 1).Value = Me.Range("净重").Cells(changedCell.row, 1).Value * 4000 Me.Range("焊口人工费").Cells(changedCell.row, 1).NumberFormat = "0" ' ElseIf Me.Range("净重").Cells(changedCell.row, 1).Value > 0 And InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "钢钉") > 0 Then ' Me.Range("焊口人工费").Cells(changedCell.row, 1).Value = Me.Range("净重").Cells(changedCell.row, 1).Value * _ ' ThisWorkbook.Sheets("DB11钢钉重量及价格").Cells(3, 3).Value / ThisWorkbook.Sheets("DB11钢钉重量及价格").Cells(3, 2).Value * 1000 ' Me.Range("焊口人工费").Cells(changedCell.row, 1).NumberFormat = "0" '如果是翅片，计算外协加工费 ElseIf Me.Range("净重").Cells(changedCell.row, 1).Value > 0 And InStr(Me.Range("名称").Cells(changedCell.row, 1).Value, "翅片") > 0 Then Me.Range("外协加工费").Cells(changedCell.row, 1).Value = Me.Range("净重").Cells(changedCell.row, 1).Value * _ ThisWorkbook.Sheets("DB13按吨加工件加工单价").Cells(3, 3).Value * 2 Me.Range("外协加工费").Cells(changedCell.row, 1).NumberFormat = "0" End If End If '这里是第一段代码分项净重的计算结束,注释掉，后面用集成净重了 ' ' 新增功能：对于汇总行净重变更，调取相关系数，计算价格并汇总 ' If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then '' Dim db4Row As Long '' Dim db4MatchRow As Long ' ' ' ' ' ' ' 获取当前行C列的值 ' cCellValue = Me.Range("材料规格").Cells(changedCell.row, 1).Value ' ' ' ' ' ' 在"DB4车间生产价格表"中查找符合条件的行 ' db4MatchRow = 0 ' For db4Row = 3 To db4Sheet.Cells(db4Sheet.Rows.Count, 1).End(xlUp).row ' If db4Sheet.Cells(db4Row, 1).Value = cCellValue Then ' If Me.Range("净重").Cells(changedCell.row, 1).Value >= db4Sheet.Cells(db4Row, 2).Value And _ ' Me.Range("净重").Cells(changedCell.row, 1).Value <= db4Sheet.Cells(db4Row, 3).Value Then ' db4MatchRow = db4Row ' Exit For ' End If ' End If ' Next db4Row ' ' ' 如果找到匹配的行，将D列的值返回到当前行的R列 ' If db4MatchRow > 0 Then ' '下面这句以后正式运行要不体现数据的话，可以取消注释掉，这里读取装焊单价 ' Me.Range("装焊单价").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 4).Value ' Me.Range("装焊人工费").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 4).Value * Me.Range("净重").Cells(changedCell.row, 1).Value ' Me.Range("装焊人工费").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("装焊人工费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ' ' '下面这句以后正式运行要不体现数据的话，可以取消注释掉，这里读取下料油漆单价 ' Me.Range("下料油漆单价").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 5).Value ' Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 5).Value * Me.Range("净重").Cells(changedCell.row, 1).Value ' Me.Range("下料油漆人工费").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ' ' '下面这句以后正式运行要不体现数据的话，可以取消注释掉，这里读取下料辅材单价 ' Me.Range("辅材单价").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 6).Value ' Me.Range("辅材费").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 6).Value * Me.Range("净重").Cells(changedCell.row, 1).Value ' Me.Range("辅材费").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("辅材费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ' ' End If ' ' '机加工费 ' Me.Range("机加工费").Cells(changedCell.row, 1).Value = Me.Range("净重").Cells(changedCell.row, 1).Value * ThisWorkbook.Sheets("DB9机加工费系数").Cells(3, 1).Value ' Me.Range("机加工费").Cells(changedCell.row, 1).NumberFormat = "0" ' Me.Range("机加工费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) ' ' End If Me.Range("净重").Cells(changedCell.row, 1).Interior.Color = xlNone Next changedCell End If '这里加一段集成净重的算法，把总成计算迁移过去 If Not Intersect(Target, Me.Range("集成计算人工费的重量").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("集成计算人工费的重量").Rows("4:" & Me.Rows.Count)) '对于分项的集成计算人工费的重量变动，调取材料系数，计算毛重，计算材料费 If changedCell.Count = 1 And changedCell.row > 3 And InStr(LCase(Me.Range("序号").Cells(changedCell.row, 1).Value), ".") > 0 Then ' 向上查找第一个不含 "." 的行 ' 向上查找第一个不含 "." 的行 upperRow = changedCell.row Do While upperRow > 1 And InStr(LCase(Me.Cells(upperRow, 1).Value), ".") > 0 upperRow = upperRow - 1 Loop ' 向下查找第一个不含 "." 的行 lowerRow = changedCell.row Do While lowerRow <= Me.Rows.Count And InStr(LCase(Me.Cells(lowerRow, 1).Value), ".") > 0 lowerRow = lowerRow + 1 Loop ' 检查这之间的行的集成计算人工费的重量单元格是否有数值 totalValue = 0 For checkRow = upperRow + 1 To lowerRow - 1 If IsNumeric(Me.Cells(checkRow, Me.Range("集成计算人工费的重量").Column).Value) Then totalValue = totalValue + Me.Cells(checkRow, Me.Range("集成计算人工费的重量").Column).Value Else totalValue = -1 ' 如果有空值或非数值，设置为-1 Exit For End If Next checkRow ' 如果所有行都有数值，将总和填写到汇总行的集成计算人工费的重量单元格 If totalValue >= 0 Then Me.Cells(lowerRow, Me.Range("集成计算人工费的重量").Column).Value = totalValue Me.Cells(lowerRow, Me.Range("集成计算人工费的重量").Column).NumberFormat = "0.000" ' Me.Cells(lowerRow, Me.Range("集成计算人工费的重量").Column).Interior.Color = RGB(0, 255, 0) End If End If '这里是第一段代码分项集成计算人工费的重量的计算结束 ' 新增功能：对于汇总行集成计算人工费的重量变更，调取相关系数，计算价格并汇总 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 获取当前行C列的值 cCellValue = Me.Range("材料规格").Cells(changedCell.row, 1).Value ' 在"DB4车间生产价格表"中查找符合条件的行 db4MatchRow = 0 For db4Row = 3 To db4Sheet.Cells(db4Sheet.Rows.Count, 1).End(xlUp).row If db4Sheet.Cells(db4Row, 1).Value = cCellValue Then If Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).Value >= db4Sheet.Cells(db4Row, 2).Value And _ Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).Value <= db4Sheet.Cells(db4Row, 3).Value Then db4MatchRow = db4Row Exit For End If End If Next db4Row ' 如果找到匹配的行，将D列的值返回到当前行的R列 If db4MatchRow > 0 Then '下面这句以后正式运行要不体现数据的话，可以取消注释掉，这里读取装焊单价 Me.Range("装焊单价").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 4).Value Me.Range("装焊人工费").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 4).Value * Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).Value Me.Range("装焊人工费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("装焊人工费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) '下面这句以后正式运行要不体现数据的话，可以取消注释掉，这里读取下料油漆单价 Me.Range("下料油漆单价").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 5).Value Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 5).Value * Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).Value Me.Range("下料油漆人工费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("下料油漆人工费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) '下面这句以后正式运行要不体现数据的话，可以取消注释掉，这里读取下料辅材单价 Me.Range("辅材单价").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 6).Value Me.Range("辅材费").Cells(changedCell.row, 1).Value = db4Sheet.Cells(db4MatchRow, 6).Value * Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).Value Me.Range("辅材费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("辅材费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If '机加工费 Me.Range("机加工费").Cells(changedCell.row, 1).Value = Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).Value * ThisWorkbook.Sheets("DB9机加工费系数").Cells(3, 1).Value Me.Range("机加工费").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("机加工费").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If Me.Range("集成计算人工费的重量").Cells(changedCell.row, 1).Interior.Color = xlNone Next changedCell End If '结束集成净重的算法 ' ' 当第一列名称包含汇总的行的I列发生变化有数值的时候，对应要求填写焊口单价，计算焊口人工费 ' If Not Intersect(Target, Me.Range("AA4:AA" & Me.Rows.Count)) Is Nothing Then ' For Each changedCell In Intersect(Target, Me.Range("AA4:AA" & Me.Rows.Count)) ' If changedCell.Count = 1 And changedCell.row > 3 And InStr(LCase(Me.Range("序号").Cells(changedCell.row, 1).Value), "汇总") > 0 Then ' ' 获取当前行的 I 列数值 ' ' If IsNumeric(Me.Cells(changedCell.row, 9).value) Then ' baseValue = Me.Cells(changedCell.row, 9).value ' Else ' baseValue = 0 ' End If ' ' ' 获取当前行的 J 列下拉列表值，并转换为数值 ' ' If IsNumeric(Replace(changedCell.value, "%", "")) Then ' discount = CDbl(Replace(changedCell.value, "%", "")) / 100 ' Else ' discount = 1 ' 默认为 100% ' End If ' ' ' 检查第27列是否为数值且大于0 ' If IsNumeric(Me.Cells(changedCell.row, 27).value) And Me.Cells(changedCell.row, 27).value > 0 Then ' ' 计算并设置当前行的 K 列价格 ' Me.Cells(changedCell.row, 28).value = Me.Cells(changedCell.row, 9).value * Me.Cells(changedCell.row, 27).value ' Me.Cells(changedCell.row, 28).NumberFormat = "0" ' 设置价格格式 ' Me.Cells(changedCell.row, 28).Interior.Color = RGB(0, 255, 0) ' End If ' End If ' ' Me.Cells(changedCell.row, 27).Interior.Color = xlNone ' Next changedCell ' End If If Not Intersect(Target, Me.Range("材料费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("材料费").Rows("4:" & Me.Rows.Count)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否是分项行（包含 "."） If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, ".") > 0 Then ' 向上查找第一个不含 "." 的行 upperRow = changedCell.row Do While upperRow > 1 And InStr(Me.Cells(upperRow, 1).Value, ".") > 0 upperRow = upperRow - 1 Loop ' 向下查找第一个不含 "." 的行 lowerRow = changedCell.row Do While lowerRow <= Me.Rows.Count And InStr(Me.Cells(lowerRow, 1).Value, ".") > 0 lowerRow = lowerRow + 1 Loop ' 检查这之间的行的材料费单元格是否有数值且大于0 totalValue = 0 For checkRow = upperRow + 1 To lowerRow - 1 If IsNumeric(Me.Cells(checkRow, Me.Range("材料费").Column).Value) Then cellValue = CDbl(Me.Cells(checkRow, Me.Range("材料费").Column).Value) If cellValue > 0 Then totalValue = totalValue + cellValue End If End If Next checkRow ' 如果总和大于0，将总和填写到汇总行的材料费单元格 If totalValue > 0 Then Me.Cells(lowerRow, Me.Range("材料费").Column).Value = totalValue Me.Cells(lowerRow, Me.Range("材料费").Column).Interior.Color = RGB(0, 255, 0) Me.Cells(lowerRow, Me.Range("材料费").Column).NumberFormat = "0" End If End If ' 检查是否是汇总行，将材料费汇总到生产成本 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算生产成本 ' Dim productionCost As Double productionCost = calculate_production_cost(changedCell.row, Me) ' 将总和填写到当前行的生产成本单元格 Me.Range("生产成本").Cells(changedCell.row, 1).Value = productionCost Me.Range("生产成本").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("生产成本").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If '制作费变更，变更到生产成本 If Not Intersect(Target, Me.Range("制作费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("制作费").Rows("4:" & Me.Rows.Count)) If changedCell.Count = 1 And changedCell.row > 3 Then ' 检查是否是汇总行，将制作费汇总到生产成本 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 调用函数计算生产成本 productionCost = calculate_production_cost(changedCell.row, Me) ' 将总和填写到当前行的生产成本单元格 Me.Range("生产成本").Cells(changedCell.row, 1).Value = productionCost Me.Range("生产成本").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("生产成本").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If '车间管理费变动时候，变更到车间成本 If Not Intersect(Target, Me.Range("车间管理费").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("车间管理费").Rows("4:" & Me.Rows.Count)) ' 检查是否是汇总行 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 初始化变量 shopManagementCost = 0 productionCost = 0 totalShopCost = 0 ' 检查车间管理费 If IsNumeric(Me.Range("车间管理费").Cells(changedCell.row, 1).Value) Then shopManagementCost = CDbl(Me.Range("车间管理费").Cells(changedCell.row, 1).Value) End If ' 检查生产成本 If IsNumeric(Me.Range("生产成本").Cells(changedCell.row, 1).Value) Then productionCost = CDbl(Me.Range("生产成本").Cells(changedCell.row, 1).Value) End If ' 检查是否两个单元格都非空且大于0 If shopManagementCost > 0 And productionCost > 0 Then ' 计算总和 totalShopCost = shopManagementCost + productionCost ' 将总和填写到当前行的车间成本单元格 Me.Range("车间成本").Cells(changedCell.row, 1).Value = totalShopCost Me.Range("车间成本").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("车间成本").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If If Not Intersect(Target, Me.Range("生产成本").Rows("4:" & Me.Rows.Count)) Is Nothing Then For Each changedCell In Intersect(Target, Me.Range("生产成本").Rows("4:" & Me.Rows.Count)) ' 检查是否是汇总行 If InStr(Me.Range("序号").Cells(changedCell.row, 1).Value, "汇总") > 0 Then ' 初始化变量 shopManagementCost = 0 productionCost = 0 totalShopCost = 0 ' 检查生产成本 If IsNumeric(Me.Range("生产成本").Cells(changedCell.row, 1).Value) Then shopManagementCost = CDbl(Me.Range("生产成本").Cells(changedCell.row, 1).Value) End If ' 检查生产成本 If IsNumeric(Me.Range("生产成本").Cells(changedCell.row, 1).Value) Then productionCost = CDbl(Me.Range("生产成本").Cells(changedCell.row, 1).Value) End If ' 检查是否两个单元格都非空且大于0 If shopManagementCost > 0 And productionCost > 0 Then ' 计算总和 totalShopCost = shopManagementCost + productionCost ' 将总和填写到当前行的车间成本单元格 Me.Range("车间成本").Cells(changedCell.row, 1).Value = totalShopCost Me.Range("车间成本").Cells(changedCell.row, 1).NumberFormat = "0" Me.Range("车间成本").Cells(changedCell.row, 1).Interior.Color = RGB(0, 255, 0) End If End If Next changedCell End If End Sub 复制代码
我来回答
( 粤ICP备18085999号-1 | 粤公网安备 44051102000585号)
狗仔卡
发表于 
置顶卡
千斤顶
显身卡
发表于 
楼主