| |
▼nonoka さん：
こんばんは
そちらがアップしたINPUT開始はバージョンが古いですね。
最新のものは変数の p1 とか p2 が追加されたものです。
Input消去 は変更有りませんが、以下にフルセットを。
なお、計画調整は、サブプロシジャ化しています。
（マクロとして選ぶことはできなくしてあります）
Sub INPUT開始()
Dim n1 As Long
Dim n2 As Long
Dim nx As Long
Dim n As Long
Dim p1 As Long
Dim p2 As Long
Dim shTo As Worksheet
Dim z1 As Long
Dim z2 As Long
Dim x As Long
Dim c As Range
Set shTo = Sheets("計画表")
With Sheets("INPUT")
Call Input消去
z1 = 7 'INPUTのコピー開始行
n1 = Val(.Range("F5").Value)
n2 = Val(.Range("H5").Value)
If n1 = 0 Or n2 = 0 Then
MsgBox "F5とH5に正しい数字をいれてくださいね"
Exit Sub
End If
n = n1 \ n2
nx = n1 Mod n2
If nx > 0 Then n = n + 1
p1 = n1 \ n
If n1 Mod n > 0 Then p1 = p1 + 1
p2 = n1 - p1 * (n - 1)
If n < 1 Then
MsgBox "F5またはH5の数字が正しくないのでは？"
Exit Sub
End If
x = 6 'コピー列数
If n > 0 Then
z2 = shTo.Range("C" & shTo.Rows.Count).End(xlUp).Row + 1
.Range("C5").Resize(, x - 1).Copy .Range("C" & z1).Resize(n)
.Range("C5").Resize(, x - 1).Copy shTo.Range("C" & z2).Resize(n)
.Range("H" & z1).Resize(n - 1).Value = p1
shTo.Range("H" & z2).Resize(n - 1).Value = p1
.Range("H" & z1).Offset(n - 1).Value = p2
shTo.Range("H" & z2).Offset(n - 1) = p2
End If
End With
Call 計画調整
End Sub
Sub Input消去()
With Sheets("INPUT")
Intersect(.Range("A1", .UsedRange).Offset(6), .Columns("C:H")).ClearContents
End With
End Sub
Private Sub 計画調整()
Dim z As Long
Dim c As Range
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim n1 As Long
Dim n2 As Long
Dim n3 As Long
Dim x1 As Long
Dim x2 As Long
Dim x3 As Long
Dim d As Date
Dim col As Variant
With Sheets("計画表")
z = .Range("C" & .Rows.Count).End(xlUp).Row - 9 'データ数
Set r1 = .Range("Q10").Resize(z)
Set r2 = .Range("R10").Resize(z)
Set r3 = .Range("V10").Resize(z)
n1 = .Range("Q6").Value
n2 = .Range("R6").Value
n3 = .Range("V6").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
If Len(.Range("Q1").Value) > 0 Then x1 = WorksheetFunction.CountIf(r1, .Range("Q1").Value)
If Len(.Range("R1").Value) > 0 Then x2 = WorksheetFunction.CountIf(r2, .Range("R1").Value)
If Len(.Range("V1").Value) > 0 Then x3 = WorksheetFunction.CountIf(r3, .Range("V1").Value)
If x1 <= n1 And x2 <= n2 And x3 <= n3 Then Exit Do
.Range("K1").Value = .Range("K1").Value + 1 '翌日
Loop
End If
End With
Next
End With
End Sub
|
|
UO3
- 13/1/29(火) 20:21 -
