Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

20288 / 76732

←次へ　｜　前へ→


	【61866】Re:EXCEL VBA 繰返しと計算結果。

おねがいします。 - 09/6/9(火) 17:29 -


	引用なし

	パスワード

▼にぃ様。

Do を↓で上手くいきました。ありがとうございました。

勉強しながらと言うか、ツギハギで作り込んでるので自身が無いんですが
おかしい(変)所があれば指摘も御願いします。

>
>>３．他(最善)の方法が別にあれば教えてください。
>
>こちらは何かいい方法が思いついたらやってみたいと思います^^
>

期待大です。。。。。^^;;

>>__________________________________
>>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
>>￣￣￣￣￣￣￣￣￣￣

1 hits

▼

【61854】EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 14:16