Excel VBA 質問スレッド No.92 (未解決)

do ループがうまくいきません。

投稿者 : ゆら     投稿日時 : 2020/07/29(Wed) 17:51:58     OS : 未指定     EXCEL : 未指定
実際に使おうとすると処理落ちしてしまいます。恐らく無限ループしているとは思うのですが、どこが原因なのかわかりません。
皆さまよろしくお願いします。

シート1にて○かどうか判断して、○ならシート2からコピーして、シート3に貼り付けていく繰り返しの作業です。
また、変数で変動しますが、シート1にて空白だった場合のみループを抜けるようにつくりたいです。

↓コードになります。

Sub 練習2()

Dim sh会, sh61 As Worksheet
Set sh会 = Worksheets("会員")
Set sh61 = Worksheets("C61")

'ここから-------------------------------------------------------------------------------------------------------

Dim x, c61コピー始, c61コピー終 As Integer
x = 2
c61コピー始 = 1
c61コピー終 = 30

Do

If sh会.Range("B" & x) = "○" Then
Range("B" & c61コピー始 & ":" & "B" & c61コピー終).Value = sh61.Range("B" & c61コピー始 & ":" & "B" & c61コピー終).Value
'○ならコピペ

ElseIf sh会.Range("B" & x) = "×" Then
'×なら何もしない

ElseIf sh会.Range("B" & x) = "" Then
'空白なら何もしない

x = x + 1
c61コピー始 = c61コピー始 + 30
c61コピー終 = c61コピー終 + 30

If sh会.Range("B" & x) = "" Then Exit Do

End If

Loop




End Sub

[返信 1] Re : do ループがうまくいきません。
投稿者 : さとし     投稿日時 : 2020/07/29(Wed) 19:08:33
おそらく、ElseIf~End Ifブロックの範囲がおかしいと思います。

'空白なら何もしない

と記載されている同じブロック内に、

xの加算処理やループの終了処理が入っていますので、

これでは無限ループになってしまいますよね。

Do~Loop内のEnd Ifを次のように直せば、うまくいくはずです。

Do

If sh会.Range("B" & x) = "○" Then
Range("B" & c61コピー始 & ":" & "B" & c61コピー終).Value = sh61.Range("B" & c61コピー始 & ":" & "B" & c61コピー終).Value
'○ならコピペ

ElseIf sh会.Range("B" & x) = "×" Then
'×なら何もしない

ElseIf sh会.Range("B" & x) = "" Then
'空白なら何もしない

End If ' 場所を移動

x = x + 1
c61コピー始 = c61コピー始 + 30
c61コピー終 = c61コピー終 + 30

If sh会.Range("B" & x) = "" Then Exit Do

Loop

スポンサード リンク
 
 
当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2020-08-10 16:36:25 )

Page
Top