这个让我疯狂,因为我已经建立了一段时间。 在逐个部分地调试代码之后,当我作为一个整体运行它时,我的Excel电子表格崩溃了。我认为这是因为我在彼此中有太多的循环......但是你告诉我。我不知道如何在不失去位置价值的情况下分解Sub:
Sub Prop()
Dim ptbl As ListObject
Set ptbl = Sheet1.ListObjects("Process")
Dim p As Range
Set p = ptbl.ListColumns("Operation").Range
Dim htbl As ListObject
Set htbl = Sheet2.ListObjects("Hourly")
Dim mtbl As ListObject
Set mtbl = Sheet1.ListObjects("Materials")
Dim m As Range
Set m = mtbl.ListColumns("Type").Range
'define process data table
Dim numOp As Range
Set numOp = ptbl.ListColumns("Number of Operators Required").Range
Dim ppHr As Range
Set ppHr = ptbl.ListColumns("Parts per Hour @ 85% Eff.").Range
Dim stpT As Range
Set stpT = ptbl.ListColumns("Set Up Time: Hours").Range
Dim scrpR As Range
Set scrpR = ptbl.ListColumns("Scrap Rate %").Range
'define process fillout tables
Dim lotz As Range 'lot size
Dim labr As Range 'labor
Dim mach As Range 'machine am.
Dim setp As Range 'setup
Dim qual As Range 'quality
Dim main As Range 'maintenance
Dim scrp As Range 'scrap
Dim totl As Range 'total
'define hourly table
Dim hrLa As Double
Dim hrMA As Double
Dim hrSe As Double
Dim hrQL As Double
Dim hrML As Double
'empty out all the cells of the process tables
For cle = 1 To 20
Sheet1.Range("Process" & cle).ClearContents
Next cle
For pr = 2 To p.Rows.Count Step 1
Dim ptn As Range
Set ptn = Sheet1.Range("Process" & pr - 1)
If p.Rows(pr).Value <> "" Then
If p.Rows(pr).Value <> "Please Choose Operation" Then
'Set the process table to have the part name
ptn(1, 1) = p.Rows(pr).Value
ptn(1, 5) = "Part Name:"
ptn(1, 6) = ptbl.ListColumns("Part Name Ref.").Range.Rows(pr).Value
ptn(1, 8) = "Parts per Hour @ 85% Eff."
ptn(2, 8) = ppHr.Rows(pr).Value
ptn(2, 1) = "Lot Size:"
ptn(3, 2) = "Costs"
ptn(3, 8) = "Hourly Rate"
ptn(4, 1) = htbl.Range(2, 1).Value
ptn(5, 1) = htbl.Range(3, 1).Value
ptn(6, 1) = htbl.Range(4, 1).Value
ptn(7, 1) = htbl.Range(5, 1).Value
ptn(8, 1) = htbl.Range(6, 1).Value
ptn(9, 1) = "Scrap Cost:"
ptn(10, 1) = "Total Cost:"
'Calculation for appropriate operations hourly rate
For r = 2 To htbl.Range.Columns.Count
If p.Rows(pr).Value = htbl.HeaderRowRange.Columns(r).Value Then
hrLa = htbl.Range(2, r).Value
ptn(4, 8) = hrLa
hrMA = htbl.Range(3, r).Value
ptn(5, 8) = hrMA
hrSe = htbl.Range(4, r).Value
ptn(6, 8) = hrSe
hrQL = htbl.Range(5, r).Value
ptn(7, 8) = hrQL
hrML = htbl.Range(6, r).Value
ptn(8, 8) = hrML
End If
Next r
Dim c As Integer
'Calculation for each cell's functions
For c = 2 To 7
'defining row name for each lot size column (c)
Set lotz = ptn(2, c)
Set labr = ptn(4, c)
Set mach = ptn(5, c)
Set setp = ptn(6, c)
Set qual = ptn(7, c)
Set main = ptn(8, c)
Set scrp = ptn(9, c)
Set totl = ptn(10, c)
'lotsize calls to estimator input
lotz = Sheet1.Range("Header")(5, c + 1)
'labor cost is pph over hourly rate
labr = (numOp.Rows(pr).Value * ppHr.Rows(pr).Value) / hrLa
'machine cost is pph over hrly rate machine
mach = ppHr.Rows(pr).Value / hrMA
'setup cost is hrly setup over lotsize
setp = (stpT.Rows(pr).Value * hrSe) / lotz
'quality cost is hrly qual over lotsize
qual = ((ptbl.Range(pr, 10).Value / 60) * ptbl.Range(pr, 11).Value) * hrQL / lotz
'maintenance is hrly maint. over lotsize
main = (ptbl.ListColumns("Maintenance per Shift: Minutes").Range.Rows(pr).Value / 60) * hrML / lotz
'total cost per part
totl = labr + mach + setp + qual + main + scrp
'Calculation for appropriate materials rate
For mt = 2 To m.Rows.Count - 1
Dim mtn As Range
Set mtn = Sheet1.Range("Materials" & mt - 1)
Dim lastMC As Double
Dim MCost As Double
If mtbl.ListColumns("Part Name").Range.Rows(mt).Value = ptbl.ListColumns("Part Name Ref.").Range.Rows(pr).Value Then
'makinig sure there is a last material cost
If mt - 2 > 0 Then
lastMC = Sheet1.Range("Materials" & mt - 2)(9, c).Value
Else: lastMC = 0
End If
MCost = mtn(9, c).Value
End If
Next mt
'scrap rate cost is material cost plus the process cost of scrap per part over the lot size
scrp = ((lastMC + MCost + labr + mach + setp + qual + main) * (scrpR.Rows(pr).Value * lotz)) / (lotz - (scrpR.Rows(pr).Value) * lotz)
Next c
End If
End If
Next pr
End Sub
如果你有任何反馈意见,那么除了意思之外,我很乐意听到它。 谢谢!