Excel VBA質問箱 IV

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

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


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

20298 / 76736

←次へ　｜　前へ→


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

にぃ - 09/6/9(火) 16:18 -


	引用なし

	パスワード

▼おねがいします。さん：
こんにちは！

>マルチになってしまいます。
>答えてネットに同じ質問をしていますが、回答が得られず困ってます。
確かこちらではマルチ禁止？となっていたような気がしますので
もうひとつのほうは閉じることをおすすめします。

>１．Sheet3.Cells(NewRow, 12) に (NewRow, 14)(NewRow, 16)(NewRow, 18)(NewRow, 20)(NewRow, 22)の合計を転記させたい。
>
>２．1件処理する毎に CommandButton1 を 1回押さなくてはいけない。
>　　(同"日"分は纏めて処理したい。)

とりあえず今の状況でこちらの１と２を追加してみました。
テストは行っていません。

>３．他(最善)の方法が別にあれば教えてください。

こちらは何かいい方法が思いついたらやってみたいと思います^^

ちなみに、「.Value」は省略させないほうがいいですよ。

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

0 hits

▼

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