Excel VBA質問箱 IV

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

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


7324 / 76732 ←次へ | 前へ→

【74996】ループ抜け教えてください
質問  hama E-MAIL  - 13/11/11(月) 20:30 -

引用なし
パスワード
   ループをA列〜D列までにしたいのですが
どうしたらよいでしょうか?現在は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

299 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