| 网站首页 | 业界新闻 | 小组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
 Reworld，下班在家制作游戏，1500万奖金等你拿 编程微博 - 发现编程界的新鲜事

已结贴   问题点数：20  回复次数：2

Sub instruct()

Dim f As Boolean
Dim SRN, ERN As Integer
Dim End_reel_N As Integer
Dim IntColor, IntColorN As Double
Dim i, j, k, l, m, n, c1 As Integer
Dim total_L, accum_L, H2_L As Single
Dim R, RH As Single

Const max_reel_num As Integer = 80

Sheets("instruct").Select

SRN = 12
ERN = SRN + max_reel_num
total_L = Range("H4").Value
End_reel_N = Range("K4").Value
H2_L = Range("AN4")
IntColor = 65535
IntColorN = 12632256

Range("K12:AP91").Select
Selection.ClearContents
With Selection.Interior
.Pattern = xlNone
End With

'慡儕乕儖應掕丂丂丟丂奜娤,OTDR
For i = 2 To End_reel_N - 1
j = SRN + i - 1

Range(Cells(j, 11), Cells(j, 13)).Select
If Cells(j, 9) = 1 Then
Selection.Interior.color = IntColor
Selection.Value = 1
Else
Selection.Interior.color = IntColorN
Selection.Value = 0
End If

Next i

'慡儕乕儖應掕丂丂丟丂MFD,Cutoff,PMD     '以下是MFD、CUTOFF、PMD的抽检，每隔4盘抽一盘。
For i = 2 To End_reel_N - 1
j = SRN + i - 1

c1 = i Mod 5
If c1 = 1 Then
If Cells(j, 9) = 1 Then
Call instruct_1(j, 15, 17, 35, IntColor, 1)   '如果是良品，则黄色显示1.

Else

Call instruct_1(j, 15, 17, 35, IntColorN, 0)  '如果是不良品，则灰色显示0.

For k = 1 To j + 10
If Cells(j - k, 9) = 1 Then

Call instruct_1(j - k, 15, 17, 35, IntColor, 1)  '判断首盘纤位置。

Exit For
End If
Next k

For k = 1 To j + 10
If Cells(j + k, 9) = 1 Then

Call instruct_1(j + k, 15, 17, 35, IntColor, 1)  '判断末盘纤位置。

Exit For
End If
Next k
End If

End If

Next i

'敳偒庢傝5儕乕儖枅丂丂丟丂Dispersion
For i = 2 To End_reel_N - 1
j = SRN + i - 1

c1 = i Mod 5                                                                '设置每隔4盘测一盘。
If c1 = 1 Then
If Cells(j, 9) = 1 Then
Call instruct_1(j, 19, 21, 23, IntColor, 1)

Else

Call instruct_1(j, 19, 21, 23, IntColorN, 0)

For k = 1 To j + 10
If Cells(j - k, 9) = 1 Then

Call instruct_1(j - k, 19, 21, 23, IntColor, 1)

Exit For
End If
Next k

For k = 1 To j + 10
If Cells(j + k, 9) = 1 Then

Call instruct_1(j + k, 19, 21, 23, IntColor, 1)

Exit For
End If
Next k
End If

End If

Next i

'慡儕乕儖應掕丂丂丟丂僋儔僢僪宎丄僋儔僢僪旕墌棪丄曃怱検丄慺慄宎     'PK2400抽检程序
For i = 2 To End_reel_N - 1
j = SRN + i - 1

c1 = i Mod 5
If c1 = 1 Then
If Cells(j, 9) = 1 Then

Call instruct_2(j, 25, 27, 29, 31, IntColor, 1)

Else

Call instruct_2(j, 25, 27, 29, 31, IntColorN, 0)

For k = 1 To j + 10
If Cells(j - k, 9) = 1 Then
Call instruct_2(j - k, 25, 27, 29, 31, IntColor, 1)
Exit For
End If
Next k

For k = 1 To j + 10
If Cells(j + k, 9) = 1 Then
Call instruct_2(j + k, 25, 27, 29, 31, IntColor, 1)
Exit For
End If
Next k

End If

End If

Next i

'嵟俙丆俛抂
c1 = SRN
Set R1 = Range(Cells(c1, 11), Cells(c1, 36))
c1 = SRN + End_reel_N - 1
Set R2 = Range(Cells(c1, 11), Cells(c1, 36))
Union(R1, R2).Select
Selection.Interior.color = IntColor
Selection.Value = 1

'悈慺帋尡                                                           'H2氢损抽检。
For i = 2 To End_reel_N - 1
j = SRN + i - 1

If Cells(j, 10) >= H2_L Then
If Cells(j, 9) = 1 And Cells(j, 8) >= 7 Then

Range(Cells(j, 37), Cells(j, 41)).Select
Selection.Interior.color = IntColor
Selection.Value = 1
Exit For

Else

Range(Cells(j, 37), Cells(j, 41)).Select
Selection.Interior.color = IntColorN
Selection.Value = 0

For k = 1 To j + 10
If Cells(j - k, 9) = 1 And Cells(j - k, 8) >= 7 Then
Range(Cells(j - k, 37), Cells(j - k, 41)).Select
Selection.Interior.color = IntColor
Selection.Value = 1
Exit For
End If

Next k
Exit For
End If
End If

Next i

'For i = 2 To End_reel_N - 1                                         '增加部分。此处开始。
'    j = SRN + i - 1
'
'    If Cells(j, 10) >= H2_L Then
'      If Cells(j, 9) = 1 And Cells(j, 8) >= 7 Then
'
'        Range(Cells(j, 37), Cells(j, 41)).Select
'        Selection.Interior.color = IntColor
'        Selection.Value = 1
'        Exit For
'
'      Else
'
'        Range(Cells(j, 37), Cells(j, 41)).Select
'        Selection.Interior.color = IntColorN
'        Selection.Value = 0
'
'        For k = 1 To j + 10
'            If Cells(j + k, 9) = 1 And Cells(j + k, 8) >= 7 Then
'                Range(Cells(j + k, 37), Cells(j + k, 41)).Select
'                Selection.Interior.color = IntColor
'                Selection.Value = 1
'                Exit For
'            End If
'
'        Next k
'        Exit For
'      End If
'    End If

'Next i                                                                 '以上部分为增加的，意为当良否判定不良时，抽上下两盘光纤氢损。 以处结束。

Range("A1").Select

End Sub

Private Sub instruct_1(i1, a1, a2, a3, color, f)

Set R1 = Cells(i1, a1)
Set R2 = Cells(i1, a2)
Set R3 = Cells(i1, a3)
Union(R1, R2, R3).Select
Selection.Interior.color = color
Selection.Value = f

End Sub

Private Sub instruct_2(i, a1, a2, a3, a4, color, f)

Set R1 = Cells(i, a1)
Set R2 = Cells(i, a2)
Set R3 = Cells(i, a3)
Set r4 = Cells(i, a4)
Union(R1, R2, R3, r4).Select
Selection.Interior.color = color
Selection.Value = f

End Sub

Sub OTDR_instruct_again()

Dim f As Boolean
Dim SRN, ERN As Integer
Dim End_reel_N As Integer
Dim IntColor, IntColorN, IntColorNull As Double
Dim i, j, k, l, m, n, c1 As Integer
Dim total_L, accum_L, H2_L As Single
Dim R, RH As Single

Const max_reel_num As Integer = 80

Sheets("instruct").Select

SRN = 10
ERN = SRN + max_reel_num
total_L = Range("H4").Value
End_reel_N = Range("K4").Value
H2_L = Range("AN4")
IntColor = 65535
IntColorN = 12632256
IntColorNull = 13434879

For i = 2 To End_reel_N - 1
j = SRN + i - 1

'敳偒庢傝5儕乕儖枅丂丂丟丂Dispersion
If Cells(j, 13) = 9 And Cells(j, 19) = 1 Then
Call instruct_1(j, 19, 21, 23, IntColorNull, 0)

For k = 1 To j + 10
If Cells(j - k, 13) = 1 Then

Call instruct_1(j - k, 19, 21, 23, IntColor, 1)

Exit For
End If
Next k

For k = 1 To j + 10
If Cells(j + k, 13) = 1 Then

Call instruct_1(j + k, 19, 21, 23, IntColor, 1)

Exit For
End If
Next k

End If

'敳偒庢傝20儕乕儖枅丂丂丟丂僋儔僢僪宎丄僋儔僢僪旕墌棪丄曃怱検丄慺慄宎
'    If Cells(j, 13) = 9 And Cells(j, 26) = 1 Then
'        Call 巜帵棫偰_2(j, 26, 28, 30, 32, IntColorNull, 0)
'
'        For k = 1 To j + 10
'            If Cells(j - k, 13) = 1 Then
'
'                Call 巜帵棫偰_2(j - k, 26, 28, 30, 32, IntColor, 1)
'
'                Exit For
'            End If
'        Next k
'
'        For k = 1 To j + 10
'            If Cells(j + k, 13) = 1 Then
'
'                Call 巜帵棫偰_2(j + k, 26, 28, 30, 32, IntColor, 1)
'
'                Exit For
'            End If
'        Next k
'
'    End If

Next i

Range("A1").Select

End Sub

得分:10

得分:10

dBase有人接盘了。
• 3
• 1/1页
• 1