Language: Excel/VisualBasic.
Objective: This spreadsheet calculates the minimum dressing depth for the backup roll of a 4-Hi rolling stand in order to avoid spalling caused by fatigue damage after a complete campaign. This version is ready to analyse a rolling stand of a Hot Strip Mill Finishing Train or a Steckel Mill. Other specific types of rolling stands can be implemented by the user. Some industrial experience is required in order to get good results.
Click here to download the Excel file or use the Visual Basic for Applications listing below.
***** Begin of Program Listing *****
'
' Program BUR_Dressing
'
' Calculation of the Minimum Dressing Depth for Backup Rolls
'
'
' Original algorithm described in
'
' NAMBU, Y.: "Suitable Dressing Amount Calculation to Prevent Fatigue Spalling"; III Meeting
' of the International Association of Steckel Mill Operators, Timóteo, March 1986.
'
'
' Excel/Visual Basic Version by Antonio Augusto Gorni - August 8, 2000
'
Option Explicit
Public Const Pi = 3.14159265
Dim CoefCond As Single
Dim YoungWork As Single
Dim YoungBackup As Single
Dim DiamWork As Single
Dim DiamBackup As Single
Dim HardBackup As Single
Dim LengthBackupWork As Single
Dim WeekProduction As Long
Dim RollChange As Integer
Dim NroWeeks As Integer
Dim BackupWear As Single
Dim WorkWear As Single
Dim BackupDress As Single
Dim MixWidth As Single
Dim MinWidth As Single
Dim MaxWidth As Single
Dim TableWidth(50, 2) As Single
Dim TableThickness(50, 2) As Single
Dim Thickness As Single
Dim MixThickness As Single
Dim PassSchedule(50) As Single
Dim RollingLoad(50) As Single
Dim SpecificLoad As Single
Dim Km As Single
Dim NroRevBackup As Long
Dim CoefDeformInterf As Single
Dim MaxLinContPress As Single
Dim MaxContPress As Single
Dim HalfContWidth As Single
Dim CoefFatLim As Single
Dim FatStrength As Single
Dim DressingAmount As Single
Dim i As Integer
Dim k As Integer
Dim w As Integer
Dim inic As Integer
Dim counter As Integer
Dim NroWidth As Integer
Dim NroThickness As Integer
Dim j As Integer
Dim ij As Integer
Dim t As Single
Dim ii As Single
Dim ff As Single
Dim z As Single
Dim da As Single
Dim lr As Single
Dim nb As Single
Dim Stand As String
Dim Buf As String
Dim Buf1 As String
Dim Buf2 As String
Dim Buf3 As String
Dim flag As Boolean
Sub Retifica()
Application.ScreenUpdating = False
CoefDeformInterf = 2900
ii = 0
ff = 0
Km = 0
BackupWear = 0
DressingAmount = 0
NroRevBackup = 0
Sheets("Stand").Select
Stand = [E6]
DiamWork = [E8]
YoungWork = [E9]
RollChange = [E10]
DiamBackup = [E12]
YoungBackup = [E13]
HardBackup = [E14]
LengthBackupWork = [E16]
WeekProduction = [E18]
NroWeeks = [E19]
CoefCond = [E21]
Range("E6").Select
Sheets("Width").Select
flag = False
inic = 8
counter = inic
Do While Cells(counter, "A") <> ""
Cells(counter, "A").Font.Color = RGB(0, 0, 0)
If Not IsNumeric(Cells(counter, "A")) Then
flag = True
Cells(counter, "A").Font.Color = RGB(255, 0, 0)
Cells(counter, "A").Value = "Error!"
End If
If Not IsNumeric(Cells(counter, "B")) Then
flag = True
Cells(counter, "B").Font.Color = RGB(255, 0, 0)
Cells(counter, "B").Value = "Error!"
End If
counter = counter + 1
Loop
If flag Then
Beep
Buf1 = "Non-numeric data detected in the Width section."
Buf2 = "Please correct the cells in red!"
MsgBox Buf1 & Chr(13) & Chr(13) & Buf2 & Chr(13), , "Warning"
Exit Sub
End If
If counter = inic + 1 Then
Beep
Buf1 = "No Width Data."
Buf2 = "Program aborted!"
MsgBox Buf1 & Chr(13) & Chr(13) & Buf2 & Chr(13), , "Erro"
Exit Sub
End If
counter = counter - 1
For i = inic To counter
TableWidth(i - inic + 1, 1) = Range("A" & i).Value
TableWidth(i - inic + 1, 2) = Range("B" & i).Value
Next i
NroWidth = counter - inic + 1
MinWidth = TableWidth(1, 1)
MaxWidth = TableWidth(NroWidth, 1)
t = 0
For i = 1 To NroWidth
t = t + TableWidth(i, 2)
Next i
If t > 105 Or t < 95 Then
Beep
Buf1 = "Somatory of width classes is wrong, different from 100%!"
Buf2 = "Program aborted!"
MsgBox Buf1 & Chr(13) & Chr(13) & Buf2 & Chr(13), , "Error"
Exit Sub
End If
Range("A8:B" & counter).Select
With Selection.Borders(xlLeft)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlRight)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlTop).LineStyle = xlNone
With Selection.Borders(xlBottom)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.BorderAround LineStyle:=xlNone
Range("A" & counter & ":B" & counter).Select
With Selection.Borders(xlBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
Selection.BorderAround LineStyle:=xlNone
Range("A8:B" & counter).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("A8:A" & counter).Select
Selection.NumberFormat = "0"
Range("B8:B" & counter).Select
Selection.NumberFormat = "0,0"
Range("A8").Select
Sheets("Pass").Select
flag = False
inic = 8
counter = inic
Do While Cells(counter, "A") <> ""
Cells(counter, "A").Font.Color = RGB(0, 0, 0)
If Not IsNumeric(Cells(counter, "B")) Then
flag = True
Cells(counter, "B").Font.Color = RGB(255, 0, 0)
Cells(counter, "B").Value = "Error!"
End If
If Not IsNumeric(Cells(counter, "C")) Then
flag = True
Cells(counter, "C").Font.Color = RGB(255, 0, 0)
Cells(counter, "C").Value = "Error!"
End If
If Not IsNumeric(Cells(counter, "D")) Then
flag = True
Cells(counter, "D").Font.Color = RGB(255, 0, 0)
Cells(counter, "D").Value = "Error!"
End If
counter = counter + 1
Loop
If flag Then
Beep
Buf1 = "Non-numeric data detected in the Pass section."
Buf2 = "Please correct the cells in red!"
MsgBox Buf1 & Chr(13) & Chr(13) & Buf2 & Chr(13), , "Warning"
Exit Sub
End If
If counter = inic Then
Beep
Buf1 = "No data in the Pass section."
Buf2 = "Program aborted!"
MsgBox Buf1 & Chr(13) & Chr(13) & Buf2 & Chr(13), , "Error"
Exit Sub
End If
counter = counter - 1
NroThickness = counter - inic + 1
Range("A8:D" & counter).Select
With Selection.Borders(xlLeft)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlRight)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlTop).LineStyle = xlNone
With Selection.Borders(xlBottom)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.BorderAround LineStyle:=xlNone
Range("A" & counter & ":D" & counter).Select
With Selection.Borders(xlBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
Selection.BorderAround LineStyle:=xlNone
Range("A8:D" & counter).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("A8:A" & counter).Select
Selection.NumberFormat = "0,00"
Range("B8:B" & counter).Select
Selection.NumberFormat = "0,0"
Range("C8:C" & counter).Select
Selection.NumberFormat = "0,00"
Range("D8:D" & counter).Select
Selection.NumberFormat = "0"
Range("A8").Select
For i = inic To counter
TableThickness(i - inic + 1, 1) = Range("A" & i).Value
TableThickness(i - inic + 1, 2) = Range("B" & i).Value
PassSchedule(i - inic + 1) = Range("C" & i).Value
RollingLoad(i - inic + 1) = Range("D" & i).Value
Next i
NroThickness = counter - inic + 1
Sheets("Results").Select
counter = 11
Do While Cells(counter, "A") <> ""
counter = counter + 1
Loop
Range("A11:F" & counter).Select
Selection.clear
[C6] = Stand
[F6] = Now()
counter = 10
t = 0
For k = 1 To NroWeeks
For i = 1 To Int(WeekProduction / RollChange)
ii = 0
For j = NroWidth To 1 Step -1
w = TableWidth(j, 1)
MixWidth = TableWidth(j, 2) / 100
For ij = 1 To NroThickness
Thickness = PassSchedule(ij)
MixThickness = TableThickness(ij, 2) / 100
SpecificLoad = RollingLoad(ij)
t = MixWidth * MixThickness * RollChange
Dress
Next ij
Next j
Next i
counter = counter + 1
Range("A" & counter) = k
Range("B" & counter) = Km / 1000000
Range("C" & counter) = NroRevBackup
Range("D" & counter) = WorkWear
Range("E" & counter) = BackupWear
Range("F" & counter) = DressingAmount
Next k
Range("A11:F" & counter).Select
With Selection.Borders(xlLeft)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlRight)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlTop).LineStyle = xlNone
With Selection.Borders(xlBottom)
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.BorderAround LineStyle:=xlNone
Range("A" & counter & ":F" & counter).Select
With Selection.Borders(xlBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
End With
Selection.BorderAround LineStyle:=xlNone
Range("A11:F" & counter).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("A11:A" & counter).Select
Selection.NumberFormat = "0"
Range("B11:B" & counter).Select
Selection.NumberFormat = "0.0"
Range("C11:C" & counter).Select
Selection.NumberFormat = "0"
Range("D11:F" & counter).Select
Selection.NumberFormat = "0.000"
Range("A11").Select
End Sub
Sub Dress()
lr = t * 1000000# / 0.0078 / Thickness / w
nb = lr / Pi / DiamBackup
WorkWear = ii + 4.7 * SpecificLoad * lr * 0.000000000001
BackupWear = ff + 0.23 * nb * 0.000001 * 2 ^ (0.1 * (68 - HardBackup))
MaxLinContPress = 1 / LengthBackupWork * (w * SpecificLoad + CoefDeformInterf / 4 * (MaxWidth + MinWidth) * (WorkWear + BackupWear))
MaxContPress = 0.836 * Sqr(MaxLinContPress * YoungWork * YoungBackup / (YoungWork + YoungBackup) * (DiamWork + DiamBackup) / DiamWork / DiamBackup)
HalfContWidth = 0.764 * Sqr(MaxLinContPress * (YoungWork + YoungBackup) / YoungWork / YoungBackup * DiamWork * DiamBackup / (DiamWork + DiamBackup))
z = -2.303 / (0.74 * HardBackup + 1.4)
CoefFatLim = 16.12 - z * (2.93 * HardBackup - 46.7)
FatStrength = Exp(z * MaxContPress + CoefFatLim)
da = CoefCond * 6# * 0.0561 * FatStrength ^ 0.091 * nb / FatStrength * HalfContWidth
ii = WorkWear
ff = BackupWear
DressingAmount = DressingAmount + da
Km = Km + lr
NroRevBackup = NroRevBackup + nb
End Sub
Sub Limpa_Dados_Laminador()
Sheets("Stand").Select
[E6] = ""
[E8] = ""
[E9] = ""
[E10] = ""
[E12] = ""
[E13] = ""
[E14] = ""
[E16] = ""
[E18] = ""
[E19] = ""
[E21] = ""
End Sub
Sub Limpa_Dados_Espessura()
Sheets("Espessura").Select
counter = 8
Do While Cells(counter, "A") <> ""
counter = counter + 1
Loop
Range("A8:B" & counter).Select
Selection.clear
End Sub
Sub Limpa_Dados_Largura()
Sheets("Width").Select
counter = 8
Do While Cells(counter, "A") <> ""
counter = counter + 1
Loop
Range("A8:B" & counter).Select
Selection.clear
End Sub
Sub Limpa_Dados_Passe()
Sheets("Pass").Select
counter = 8
Do While Cells(counter, "A") <> ""
counter = counter + 1
Loop
Range("A8:D" & counter).Select
Selection.clear
End Sub
***** End of Program Listing ******
Return to the Software Menu.
 |
Last Update: 18 December 2002 | |
| © Antonio Augusto Gorni |