Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7324 / 76732 ←次へ　｜　前へ→
【74996】ループ抜け教えてください
質問  hama E-MAIL  - 13/11/11(月) 20:30 -
引用なし
パスワード
   ループをＡ列〜Ｄ列までにしたいのですが
どうしたらよいでしょうか？現在はLoop Until ""で何もなかったら
抜けるにしてあります。範囲を設定したいのですが初心者なのでわかりません
どなたか教えてください。

Sub 後シート色づけ()

　　Dim Ans1 As Variant
　　Dim Ans2 As Variant
　　Dim NewXcel As Long
　　Dim NewYcel As Long
　　Dim OldXcel As Long
　　Dim OldYcel As Long
　　Dim ites As Variant
　　Dim Obj1 As Variant


NewYcel = 2

Do

　　Ans1 = Sheets("後").Cells(NewYcel, 1)　　　　　　　　　　　　　　　　　　　　　
　　
　　Set Obj1 = Worksheets("前").Cells.Find(Ans1)　　　　　　　　　　　　　　　　　　
　　
　　If Obj1 Is Nothing Then　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　
　　　　Sheets("後").Cells.Find(Ans1).Interior.ColorIndex = 27　　　　　　　　　　
　　　　
　　　　Else　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

　　　　　　NewXcel = 2
　　　　　　OldXcel = 2
　　　　　　OldYcel = Worksheets("前").Cells.Find(Ans1).Row　　　　　　　　　　　　
　　　　　　
　　　　Do
　　　　　　If Worksheets("前").Cells(OldYcel, OldXcel) = Worksheets("後").Cells(NewYcel, NewXcel) Then
　　　　
　　　　　　Else
　　　　　　
　　　　　　　　Worksheets("後").Cells(NewYcel, NewXcel).Interior.ColorIndex = 27　
　　　　
　　　　　　End If
　　　　　　
　　　　　　NewXcel = NewXcel + 1　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　　　OldXcel = OldXcel + 1　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　　　Ans2 = Sheets("後").Cells(NewYcel, NewXcel)　　　　　　　　　　　　　　
　　　　　　
　　　　Loop Until Ans2 = ""　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　
　　End If
　　
　　NewYcel = NewYcel + 1　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　
　　ites = Sheets("後").Cells(NewYcel, 1)　　　　　　　　　　　　　　　　　　　　　

Loop Until ites = ""　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

End Sub
300 hits
▼ 【74996】ループ抜け教えてください hama 13/11/11(月) 20:30 質問≪
【74998】Re:ループ抜け教えてください kanabun 13/11/12(火) 10:01 発言
【75000】Re:ループ抜け教えてください hama 13/11/12(火) 11:02 回答
【75001】Re:ループ抜け教えてください kanabun 13/11/12(火) 12:03 発言
【75002】Re:ループ抜け教えてください hama 13/11/12(火) 13:30 お礼
【75005】Re:ループ抜け教えてください hama 13/11/12(火) 20:28 質問
【75006】Re:ループ抜け教えてください kanabun 13/11/12(火) 22:17 発言
【75007】Re:ループ抜け教えてください hama 13/11/12(火) 23:22 回答
【75008】Re:ループ抜け教えてください kanabun 13/11/12(火) 23:45 発言
【75009】Re:ループ抜け教えてください hama 13/11/13(水) 2:15 お礼
【74999】Re:ループ抜け教えてください kanabun 13/11/12(火) 10:40 発言
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7324 / 76732 ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free