Excel VBA質問箱 IV

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

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


36106 / 76732 ←次へ | 前へ→

【45811】Re:Do until について
回答  Kein  - 07/1/14(日) 23:35 -

引用なし
パスワード
   では、こんな感じで。

Sub MyYear_Data()
  Dim Sh1 As Worksheet, Sh2 As Worksheet
  Dim MyR As Range, MyR2 As Range, C As Range
  Dim Rw As Long
 
  Set Sh1 = Worksheets("Sheet1"): Set Sh2 = Worksheets("work")
  Application.ScreenUpdating = False
  With Sh1.Range("A2", Sh1.Range("A65536").End(xlUp)).Offset(, 1)
   .Formula = "=IF($A2<>$A3,COUNTIF($A$2:$A2,$A2))"
   .Value = .Value
   Set MyR = .SpecialCells(2, 1)
  End With
  For Each C In MyR
   Rw = C.Value
   Set MyR2 = C.Offset(-1 * (Rw - 1)).Resize(Rw).EntireRow
   MyR2.Copy Sh2.Range("A2")
   Sh2.Range("B:B").ClearContents

   'ここへ変数 Sh2 を使って、コピーしたデータの加工をするコードを書く
   
   MyR2.ClearContents: Set MyR2 = Nothing
  Next
  Sh2.Activate
  Set MyR = Nothing: Set Sh1 = Nothing: Set Sh2 = Nothing
  Application.ScreenUpdating = True
End Sub
1 hits

【45801】Do until について さくら 07/1/14(日) 20:37 質問
【45803】Re:Do until について Kein 07/1/14(日) 21:39 回答
【45809】Re:Do until について さくら 07/1/14(日) 22:30 質問
【45811】Re:Do until について Kein 07/1/14(日) 23:35 回答
【45815】Re:Do until について さくら 07/1/15(月) 5:46 お礼

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