Excel VBA質問箱 IV

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

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


20260 / 76736 ←次へ | 前へ→

【61898】Re:EXCEL VBA 繰返しと計算結果。
質問  おねがいします。  - 09/6/11(木) 11:39 -

引用なし
パスワード
   ▼にぃ 様

こんにちは。お世話になってます。
先日はありがとうございました。

先日から早速試しているんですが、躓いてます。助けてください。

>Private Sub CommandButton1_Click()
>  Dim Ws3 As Worksheet
>  Dim Ws4 As Worksheet
>  Dim v3 As Variant
>  Dim v4 As Variant
>  Dim LastRow3 As Long
>  Dim LastRow4 As Long
>  Dim NewRow As Long
>  Dim delRows As Long
>  Dim delRowStart As Long
>  Dim delRowEnd As Long
>  Dim I As Long
>  
>  Set Ws3 = Sheet3
>  Set Ws4 = Sheet4
>  
>  If (Me.TextBox1.Text = "") Then
>    MsgBox "*****日を入力してください。", vbInformation, "入力エラー"
>    Exit Sub
>  End If
>  
>  With Ws3
>    LastRow3 = .Range("A" & .Rows.Count).End(xlUp).Row 'sheet3のA列の最後の行の値
>    v3 = .Range("A1:A" & LastRow3).Value 'バリアントに代入
>      
>    For I = 3 To LastRow3
>      If Trim(v3(I, 1)) = "" Then '空白行がある場合
>        I = NewRow
>        Exit For
>      End If
>    Next

  代入のところで値が違います。と出てきます。If Trim(v3(I, 1))
  そこで、LastRow3 = .Range & v3 = .Range の前に Ws3.Range としてみたり
  ↓不等号を < に変えてみたり色々と試してみたんですが、
  ["入力シートに設定できる行がありません。"]または、転記操作の
  Sheet3.Range("A" & NewRow) で [NewRow=0] となります。

  試練を与えて頂いたと思い色々と調べてみたんですが、分かりませんでした。

  申し訳ありませんが、引き続きお願い出来ないでしょうか?
  宜しくお願いします。

>    
>    If I > LastRow3 Then ''lastrow3を超えてしまったら
>      MsgBox "入力シートに設定できる行がありません。", vbAbortRetryIgnore, "空白行検索"
>      Exit Sub
>    End If
>  End With
>  
>  With Ws4
>    LastRow4 = .Range("A" & .Rows.Count).End(xlUp).Row 'sheet4のA列の最後の行の値
>    v4 = .Range("A1:A" & LastRow4).Value 'バリアントに代入
>    
>    For I = 2 To LastRow4
>      If Me.TextBox1.Text = v4(I, 1) Then '同じ日がある場合、転記操作を行う
>        '*******************************************************************************
>        '転記操作
>        Sheet3.Range("A" & NewRow).Value = .Range("A" & I).Value
>        Sheet3.Range("B" & NewRow).Resize(, 9).Value = .Range("C" & I).Resize(, 9).Value
>        Sheet3.Range("K" & NewRow).Value = .Range("AC" & I).Value
>        Sheet3.Range("M" & NewRow).Value = .Range("X" & I).Value
>        Sheet3.Range("N" & NewRow).Value = Application.RoundDown _
>          (Application.WorksheetFunction.Sum(.Range("X" & I).Value / 21 * 35) / 1, 0)
>        Sheet3.Range("O" & NewRow).Resize(, 2).Value = .Range("Y" & I).Value
>        Sheet3.Range("Q" & NewRow).Value = .Range("Z" & I).Value
>        Sheet3.Range("R" & NewRow).Value = Application.RoundDown _
>          (Application.WorksheetFunction.Sum(.Range("Z" & I).Value / 4 * 7) / 1, 0)
>        Sheet3.Range("S" & NewRow).Resize(, 2).Value = .Range("AA" & I).Value
>        Sheet3.Range("W" & NewRow).Resize(, 2).Value = .Range("AD" & I).Resize(, 2).Value
>        Sheet3.Range("L" & NewRow).Value = Sheet3.Range("N" & NewRow).Value + _
>                          Sheet3.Range("P" & NewRow).Value + _
>                          Sheet3.Range("R" & NewRow).Value + _
>                          Sheet3.Range("T" & NewRow).Value + _
>                          Sheet3.Range("V" & NewRow).Value
>        NewRow = NewRow + 1 '次の代入行へ
>        delRows = delRows + 1 '削除する回数分の行数を取得
>        '*******************************************************************************
>        If Me.TextBox1.Text <> v4(I + 1, 1) Then '次の行が異なればループを抜ける
>          delRowEnd = I '終わりの行を取得
>          Exit For
>        End If
>      End If
>    Next
>    
>    If I > LastRow4 Then 'lastrow4を超えてしまったら
>      MsgBox "入力された*****日は存在しませんでした。確認してください。", vbAbortRetryIgnore, "*****日エラー"
>      Exit Sub
>    End If
>    
>    If delRows <> 0 Then
>      delRowStart = delRowEnd - delRows + 1 '削除する最初の行を取得
>      .Rows(delRowStart & ":" & delRowEnd).Delete Shift:=xlUp
>    End If
>  
>  End With
>  
>  Set Ws3 = Nothing
>  Set Ws4 = Nothing
>  
>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 お礼

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