Excel VBA質問箱 IV

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

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


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

20300 / 76732

←次へ　｜　前へ→


	【61854】EXCEL VBA 繰返しと計算結果。

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


	引用なし

	パスワード

お手数ですが宜しくお願い致します。

マルチになってしまいます。
答えてネットに同じ質問をしていますが、回答が得られず困ってます。

まず、別のエクセルファイルからデータを取り込みます。(←ここは別途)
取り込んだデータ(約200件分)を集計/転記するんですが、

１．Sheet3.Cells(NewRow, 12) に (NewRow, 14)(NewRow, 16)(NewRow, 18)(NewRow, 20)(NewRow, 22)の合計を転記させたい。

２．1件処理する毎に CommandButton1 を 1回押さなくてはいけない。
　　(同"日"分は纏めて処理したい。)

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

宜しくお願いします。

__________________________________
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
　　　　
　　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))
　　　　
　　Call Sheet4.Activate
　　　　Rows(CStr(I)).Select
　　　　　　Selection.Delete Shift:=xlUp

End Sub
￣￣￣￣￣￣￣￣￣￣

1 hits

▼

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

≪