|
▼にぃ 様。
Do を↓で上手くいきました。ありがとうございました。
勉強しながらと言うか、ツギハギで作り込んでるので自身が無いんですが
おかしい(変)所があれば指摘も御願いします。
>
>>3.他(最善)の方法が別にあれば教えてください。
>
>こちらは何かいい方法が思いついたらやってみたいと思います^^
>
期待大です。。。。。^^;;
>>__________________________________
>>Private Sub CommandButton1_Click()
>>
>> Dim I As Long
>> Dim doendFLG As Boolean
>> Dim IR As String
>>
>> If (Me.TextBox1.Text = "") Then
>> MsgBox "*****日を入力してください。", vbInformation, "入力エラー"
>> Exit Sub
>> End If
>>
>> I = 2
>> doendFLG = False
>> Do While (I <= 65535 And doendFLG = False)
>> If (Sheet4.Cells(I, 1) = Me.TextBox1.Text) Then
>> doendFLG = True
>> Else
>> I = I + 1
>> End If
>> Loop
>> If (doendFLG = False) Then
>> MsgBox "入力された*****日は存在しませんでした。確認してください。", vbAbortRetryIgnore, "*****日エラー"
>> Exit Sub
>> End If
Do
>> roopflg = True
>> NewRow = 3
>> Do While (roopflg = True And NewRow < 65530)
>> If Trim(Sheet3.Cells(NewRow, 1)) = "" Then
>> roopflg = False
>> Else
>> NewRow = NewRow + 1
>> End If
>> Loop
>> If (roopflg = True) Then
>> MsgBox "入力シートに設定できる行がありません。", vbAbortRetryIgnore, "空白行検索"
>> Exit Sub
>> End If
>>
>
> Do
>
>> Call Sheet3.Activate
>> Sheet3.Cells(NewRow, 1) = Sheet4.Range("A" & CStr(I))
>> Sheet3.Cells(NewRow, 2) = Sheet4.Range("C" & CStr(I))
>> Sheet3.Cells(NewRow, 3) = Sheet4.Range("D" & CStr(I))
>> Sheet3.Cells(NewRow, 4) = Sheet4.Range("E" & CStr(I))
>> Sheet3.Cells(NewRow, 5) = Sheet4.Range("F" & CStr(I))
>> Sheet3.Cells(NewRow, 6) = Sheet4.Range("G" & CStr(I))
>> Sheet3.Cells(NewRow, 7) = Sheet4.Range("H" & CStr(I))
>> Sheet3.Cells(NewRow, 8) = Sheet4.Range("I" & CStr(I))
>> Sheet3.Cells(NewRow, 9) = Sheet4.Range("J" & CStr(I))
>> Sheet3.Cells(NewRow, 10) = Sheet4.Range("K" & CStr(I))
>> Sheet3.Cells(NewRow, 11) = Sheet4.Range("AC" & CStr(I))
>> Sheet3.Cells(NewRow, 13) = Sheet4.Range("X" & CStr(I))
>> Sheet3.Cells(NewRow, 14) = Application.RoundDown _
>> (Application.WorksheetFunction.Sum(Sheet4.Range("X" & CStr(I)) / 21 * 35) / 1, 0)
>> Sheet3.Cells(NewRow, 15) = Sheet4.Range("Y" & CStr(I))
>> Sheet3.Cells(NewRow, 16) = Sheet4.Range("Y" & CStr(I))
>> Sheet3.Cells(NewRow, 17) = Sheet4.Range("Z" & CStr(I))
>> Sheet3.Cells(NewRow, 18) = Application.RoundDown _
>> (Application.WorksheetFunction.Sum(Sheet4.Range("Z" & CStr(I)) / 4 * 7) / 1, 0)
>> Sheet3.Cells(NewRow, 19) = Sheet4.Range("AA" & CStr(I))
>> Sheet3.Cells(NewRow, 20) = Sheet4.Range("AA" & CStr(I))
>> Sheet3.Cells(NewRow, 23) = Sheet4.Range("AD" & CStr(I))
>> Sheet3.Cells(NewRow, 24) = Sheet4.Range("AE" & CStr(I))
>>
> With Sheet3.Cells(NewRow, 12)
> .Value = .Offset(, 2).Value + .Offset(, 4).Value + .Offset(, 6).Value _
> + .Offset(, 8).Value + .Offset(, 10).Value
> End With
>
>> Call Sheet4.Activate
>> Rows(CStr(I)).Select
>> Selection.Delete Shift:=xlUp
>>
> If Sheet4.Range("A" & I).Value <> Me.TextBox1.Text Then '転記させた行は削除しているようなので
> Exit Do 'Iは同じ数字で比較する
> End If '異なる場合ループを抜ける
> Loop
>
>>End Sub
>> ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄
|
|