| |
▼UO3 さん：
おはようございます！
昨日、試行錯誤して素人ながら関数をなくして下記コードにしました。
中段のＯＧ工程からＩＮＳ工程でＮ〜ＡＡに入力するようにしました。
関数をそのままコードにしただけです。動作確認済みです。
これで対応できますか？
Private Sub 計画調整()
Dim z As Long
Dim c As Range
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range
Dim r5 As Range
Dim r6 As Range
Dim r7 As Range
Dim r8 As Range
Dim r9 As Range
Dim r10 As Range
Dim r11 As Range
Dim r12 As Range
Dim r13 As Range
Dim r14 As Range
Dim n1 As Long
Dim n2 As Long
Dim n3 As Long
Dim n4 As Long
Dim n5 As Long
Dim n6 As Long
Dim n7 As Long
Dim n8 As Long
Dim n9 As Long
Dim n10 As Long
Dim n11 As Long
Dim n12 As Long
Dim n13 As Long
Dim n14 As Long
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim x4 As Long
Dim x5 As Long
Dim x6 As Long
Dim x7 As Long
Dim x8 As Long
Dim x9 As Long
Dim x10 As Long
Dim x11 As Long
Dim x12 As Long
Dim x13 As Long
Dim x14 As Long
Dim d As Date
Dim col As Variant
With Sheets("Schedule")
z = .Range("C" & .Rows.Count).End(xlUp).Row - 9 'データ数
Set r1 = .Range("N10").Resize(z)
Set r2 = .Range("O10").Resize(z)
Set r3 = .Range("P10").Resize(z)
Set r4 = .Range("Q10").Resize(z)
Set r5 = .Range("R10").Resize(z)
Set r6 = .Range("S10").Resize(z)
Set r7 = .Range("T10").Resize(z)
Set r8 = .Range("U10").Resize(z)
Set r9 = .Range("V10").Resize(z)
Set r10 = .Range("W10").Resize(z)
Set r11 = .Range("X10").Resize(z)
Set r12 = .Range("Y10").Resize(z)
Set r13 = .Range("Z10").Resize(z)
Set r14 = .Range("AA10").Resize(z)
n1 = .Range("N6").Value
n2 = .Range("O6").Value
n3 = .Range("P6").Value
n4 = .Range("Q6").Value
n5 = .Range("R6").Value
n6 = .Range("S6").Value
n7 = .Range("T6").Value
n8 = .Range("U6").Value
n9 = .Range("V6").Value
n10 = .Range("W6").Value
n11 = .Range("X6").Value
n12 = .Range("Y6").Value
n13 = .Range("Z6").Value
n14 = .Range("AA6").Value
For Each c In .Range("C10").Resize(z)
With c.EntireRow
If Len(.Range("K1").Value) = 0 Then 'K列未セットのものだけ
.Range("K1").Value = c.Value '入力日->開始日
Do
x1 = 0
x2 = 0
x3 = 0
x4 = 0
x5 = 0
x6 = 0
x7 = 0
x8 = 0
x9 = 0
x10 = 0
x11 = 0
x12 = 0
x13 = 0
x14 = 0
s1 = .Range("AD1").Value
s2 = .Range("AE1").Value
s3 = .Range("AF1").Value
s4 = .Range("AG1").Value
s5 = .Range("AH1").Value
s6 = .Range("AI1").Value
s7 = .Range("AJ1").Value
s8 = .Range("AK1").Value
s9 = .Range("AL1").Value
s10 = .Range("AM1").Value
s11 = .Range("AN1").Value
s12 = .Range("AO1").Value
s13 = .Range("AP1").Value
s14 = .Range("AQ1").Value
'OG工程
If Val(s1) = 1 Then
.Range("N1").Value = .Range("K1").Value + Val(s1)
Else
.Range("N1").ClearContents
End If
'RX工程
If Val(s2) = 1 Then
.Range("O1").Value = .Range("N1").Value + Val(s2)
Else
.Range("O1").ClearContents
End If
'PS工程
If Val(s3) = 1 Then
.Range("P1").Value = .Range("O1").Value + Val(s3)
ElseIf Val(s3) = 0 Then
.Range("P1").ClearContents
Else
.Range("P1").Value = .Range("N1").Value + Val(s4)
End If
'DYE-D工程
If Val(s4) = 0 Then
.Range("Q1").ClearContents
ElseIf Val(s3) = 0 Then
.Range("Q1").Value = .Range("N1").Value + Val(s4)
Else
.Range("Q1").Value = .Range("P1").Value + Val(s4)
End If
'DYE-L工程
If Val(s5) = 0 Then
.Range("R1").ClearContents
ElseIf Val(s3) = 0 Then
.Range("R1").Value = .Range("N1").Value + Val(s5)
Else
.Range("R1").Value = .Range("P1").Value + Val(s5)
End If
'MS工程
If Val(s6) = 0 Then
.Range("S1").ClearContents
ElseIf Val(s5) = 1 Then
.Range("S1").Value = .Range("R1").Value + Val(s6)
Else
.Range("S1").Value = .Range("Q1").Value + Val(s6)
End If
'RC工程
If Val(s7) = 0 Then
.Range("T1").ClearContents
Else
.Range("T1").Value = .Range("S1").Value + Val(s7)
End If
'DRY工程
If Val(s8) = 0 Then
.Range("U1").ClearContents
Else
.Range("U1").Value = .Range("T1").Value + Val(s8)
End If
'FS工程
If Val(s9) = 0 Then
.Range("V1").ClearContents
ElseIf Val(s8) = 1 Then
.Range("V1").Value = .Range("U1").Value + Val(s9)
Else
If Val(s7) = 1 Then
.Range("V1").Value = .Range("T1").Value + Val(s9)
ElseIf Val(s5) = 0 Then
.Range("V1").Value = .Range("Q1").Value + Val(s9)
Else
.Range("V1").Value = .Range("R1").Value + Val(s9)
End If
End If
'INS工程
.Range("W1").Value = .Range("V1").Value + Val(s10)
.Range("X1").Value = .Range("W1").Value + Val(s11)
.Range("Y1").Value = .Range("X1").Value + Val(s12)
.Range("Z1").Value = .Range("Y1").Value + Val(s13)
.Range("AA1").Value = .Range("Z1").Value + Val(s14)
If Len(.Range("N1").Value) > 0 Then x1 = WorksheetFunction.CountIf(r1, .Range("N1").Value)
If Len(.Range("O1").Value) > 0 Then x2 = WorksheetFunction.CountIf(r2, .Range("O1").Value)
If Len(.Range("P1").Value) > 0 Then x3 = WorksheetFunction.CountIf(r3, .Range("P1").Value)
If Len(.Range("Q1").Value) > 0 Then x4 = WorksheetFunction.CountIf(r4, .Range("Q1").Value)
If Len(.Range("R1").Value) > 0 Then x5 = WorksheetFunction.CountIf(r5, .Range("R1").Value)
If Len(.Range("S1").Value) > 0 Then x6 = WorksheetFunction.CountIf(r6, .Range("S1").Value)
If Len(.Range("T1").Value) > 0 Then x7 = WorksheetFunction.CountIf(r7, .Range("T1").Value)
If Len(.Range("U1").Value) > 0 Then x8 = WorksheetFunction.CountIf(r8, .Range("U1").Value)
If Len(.Range("V1").Value) > 0 Then x9 = WorksheetFunction.CountIf(r9, .Range("V1").Value)
If Len(.Range("W1").Value) > 0 Then x10 = WorksheetFunction.CountIf(r10, .Range("W1").Value)
If Len(.Range("X1").Value) > 0 Then x11 = WorksheetFunction.CountIf(r11, .Range("X1").Value)
If Len(.Range("Y1").Value) > 0 Then x12 = WorksheetFunction.CountIf(r12, .Range("Y1").Value)
If Len(.Range("Z1").Value) > 0 Then x13 = WorksheetFunction.CountIf(r13, .Range("Z1").Value)
If Len(.Range("AA1").Value) > 0 Then x14 = WorksheetFunction.CountIf(r14, .Range("AA1").Value)
If x1 <= n1 And x2 <= n2 And x3 <= n3 And x4 <= n4 And x5 <= n5 And x6 <= n6 And x7 <= n7 And x8 <= n8 And x9 <= n9 And x10 <= n10 And x11 <= n11 And x12 <= n12 And x13 <= n13 And x14 <= n14 Then Exit Do
.Range("K1").Value = .Range("K1").Value + 1 '翌日
Loop
End If
End With
Next
End With
End Sub
|
|
nonoka
- 13/3/19(火) 9:27 -
