Excel VBA質問箱 IV

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

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


20294 / 76732 ←次へ | 前へ→

【61860】Re:EXCEL VBA 繰返しと計算結果。
回答  にぃ  - 09/6/9(火) 16:18 -

引用なし
パスワード
   ▼おねがいします。 さん:
こんにちは!

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

>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
> ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄

0 hits

【61854】EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 14:16 質問
【61860】Re:EXCEL VBA 繰返しと計算結果。 にぃ 09/6/9(火) 16:18 回答
【61862】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 16:45 お礼
【61863】Re:EXCEL VBA 繰返しと計算結果。 にぃ 09/6/9(火) 16:52 発言
【61866】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 17:29 お礼
【61878】Re:EXCEL VBA 繰返しと計算結果。 にぃ 09/6/10(水) 10:37 発言
【61888】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/10(水) 15:55 お礼
【61898】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 11:39 質問
【61899】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/11(木) 14:08 発言
【61902】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 16:16 お礼
【61904】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/11(木) 17:35 発言
【61905】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 18:34 お礼
【61912】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/11(木) 22:18 発言
【61922】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/12(金) 10:14 お礼
【61924】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/12(金) 10:34 発言
【61901】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/11(木) 15:12 発言
【61903】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/11(木) 16:20 お礼
【61919】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/12(金) 8:46 発言
【61925】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/12(金) 10:49 お礼
【61935】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/12(金) 22:21 回答
【61968】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/15(月) 15:03 お礼
【61934】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/12(金) 17:34 質問
【61936】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/12(金) 23:56 回答
【61938】Re:EXCEL VBA 繰返しと計算結果。 Hirofumi 09/6/13(土) 8:59 回答
【61963】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/15(月) 10:19 お礼
【61861】Re:EXCEL VBA 繰返しと計算結果。 neptune 09/6/9(火) 16:30 発言
【61864】Re:EXCEL VBA 繰返しと計算結果。 おねがいします。 09/6/9(火) 17:01 お礼

20294 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free