|
▼おねがいします。 さん:
こんにちは!
>マルチになってしまいます。
>答えてネットに同じ質問をしていますが、回答が得られず困ってます。
確かこちらではマルチ禁止?となっていたような気がしますので
もうひとつのほうは閉じることをおすすめします。
>1.Sheet3.Cells(NewRow, 12) に (NewRow, 14)(NewRow, 16)(NewRow, 18)(NewRow, 20)(NewRow, 22)の合計を転記させたい。
>
>2.1件処理する毎に CommandButton1 を 1回押さなくてはいけない。
> (同"日"分は纏めて処理したい。)
とりあえず今の状況でこちらの1と2を追加してみました。
テストは行っていません。
>3.他(最善)の方法が別にあれば教えてください。
こちらは何かいい方法が思いついたらやってみたいと思います^^
ちなみに、「.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
> ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄
|
|