[已解决]vba代码报错过程太大

颂风侯 · 发表于 2025-5-16 18:23:02

'已完成，作用：当表格执行删除行操作时候，标记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

复制代码

这是一个excel的vba代码，感觉写的很乱了，我后面继续写点什么，excel操作下就报过程太大的错误，大神们帮看看怎么办，最好能简化下代码，写得清晰些，去掉不要的部分，加速运行速度，减小内存，但是不要搞太复杂呢。

最佳答案

月排行榜 / 总排行榜

FishC

2025-5-16 18:23:03

问题分析及解决方案

从代码结构来看，主要问题出在Worksheet_Change事件过程中代码过长导致"过程太大"错误。这是VBA对单个过程代码量的限制（约64KB）。以下是优化建议：

将功能模块拆分成多个子过程
使用Call调用各功能模块
优化重复代码段
减少事件过程中的直接处理逻辑

优化步骤：

1. 将主要功能拆分为独立子过程：

' 主事件处理程序
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
Call HandleNameChange(Target)
Call HandleMaterialChange(Target)
Call HandleDimensionChange(Target)
Call HandleQuantityChange(Target)
' 其他模块调用...
End Sub
' 处理名称变更的子过程
Private Sub HandleNameChange(ByVal Target As Range)
If Not Intersect(Target, Me.Range("名称").Rows("4:" & lastRow)) Is Nothing Then
' 原有处理逻辑...
End If
End Sub
' 处理材质变更的子过程
Private Sub HandleMaterialChange(ByVal Target As Range)
If Not Intersect(Target, Me.Range("材质").Rows("4:" & lastRow)) Is Nothing Then
' 原有处理逻辑...
End If
End Sub

复制代码

2. 优化重复代码段（示例）：

' 通用数据验证设置子过程
Private Sub SetValidation(ByVal Target As Range, ByVal List As String)
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=List
.IgnoreBlank = True
.InCellDropdown = True
End With
End Sub

复制代码

3. 优化对象引用：

' 使用With语句优化工作表引用
Private Sub GetDB2Data()
With ThisWorkbook.Sheets("DB2材料及单价")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' 其他操作...
End With
End Sub

复制代码

注意事项：

将公共变量声明在模块顶部
使用Application.EnableEvents = False避免事件循环触发
复杂计算逻辑封装成独立函数
使用错误处理避免意外中断

完整优化方案需要根据实际业务逻辑进一步拆分，建议按功能模块逐步重构。如果需要具体某个功能的优化示例，可以提供具体代码段我再给出针对性建议。

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。

跳转到最佳答案楼层

FishC · 发表于 2025-5-16 18:23:03

问题分析及解决方案

从代码结构来看，主要问题出在Worksheet_Change事件过程中代码过长导致"过程太大"错误。这是VBA对单个过程代码量的限制（约64KB）。以下是优化建议：

将功能模块拆分成多个子过程
使用Call调用各功能模块
优化重复代码段
减少事件过程中的直接处理逻辑

优化步骤：

1. 将主要功能拆分为独立子过程：

' 主事件处理程序
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
Call HandleNameChange(Target)
Call HandleMaterialChange(Target)
Call HandleDimensionChange(Target)
Call HandleQuantityChange(Target)
' 其他模块调用...
End Sub
' 处理名称变更的子过程
Private Sub HandleNameChange(ByVal Target As Range)
If Not Intersect(Target, Me.Range("名称").Rows("4:" & lastRow)) Is Nothing Then
' 原有处理逻辑...
End If
End Sub
' 处理材质变更的子过程
Private Sub HandleMaterialChange(ByVal Target As Range)
If Not Intersect(Target, Me.Range("材质").Rows("4:" & lastRow)) Is Nothing Then
' 原有处理逻辑...
End If
End Sub

复制代码

2. 优化重复代码段（示例）：

' 通用数据验证设置子过程
Private Sub SetValidation(ByVal Target As Range, ByVal List As String)
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=List
.IgnoreBlank = True
.InCellDropdown = True
End With
End Sub

复制代码

3. 优化对象引用：

' 使用With语句优化工作表引用
Private Sub GetDB2Data()
With ThisWorkbook.Sheets("DB2材料及单价")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' 其他操作...
End With
End Sub

复制代码

注意事项：

将公共变量声明在模块顶部
使用Application.EnableEvents = False避免事件循环触发
复杂计算逻辑封装成独立函数
使用错误处理避免意外中断

完整优化方案需要根据实际业务逻辑进一步拆分，建议按功能模块逐步重构。如果需要具体某个功能的优化示例，可以提供具体代码段我再给出针对性建议。

以上回复来自 FishC AI 小助理，如未能正确解答您的问题，请继续追问。

颂风侯 · 发表于 2025-5-16 18:27:13

能直接优化下代码试试吗，找不到方向啊

快速收敛 · 发表于 2025-8-7 14:46:04

FishC 发表于 2025-5-16 18:23
问题分析及解决方案

从代码结构来看，主要问题出在Worksheet_Change事件过程中代码过长导致"过程太大"错 ...

最棒

不二如是 · 发表于 2025-9-15 17:06:40

如此澎湃的代码，遇到什么错误了？

空python · 发表于 3 天前

棒棒达

账号		自动登录	找回密码
密码			立即注册

[已解决]vba代码报错过程太大

最佳答案

浏览过的版块