Excel VBA質問箱 IV

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

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


58638 / 76732 ←次へ | 前へ→

【22818】Re:Sheet1のデータをSheet2に条件をつけて複...
回答  Jaka  - 05/3/4(金) 13:00 -

引用なし
パスワード
   こんにちは。
おじゃまします。

全く違う方法ですが....。
P列を作業列に使ってます。
不都合でしたら、適当な列に変更してください。

Sub hsdndh()
  Dim S2ER As Long, i As Long
  Application.ScreenUpdating = False
  Sheets("Sheet1").UsedRange.Copy
  With Sheets("Sheet2")
    .Range("A1").PasteSpecial
    S2ER = .Range("O65536").End(xlUp).Row
    .Range("O2:O" & S2ER).Offset(, 1).Formula = "=COUNTIF(O$1:O2,O2)&""/""&O2"
    For i = S2ER To 2 Step -1
      .Rows(i).Copy
      .Rows(i).Resize(.Cells(i, "O").Value - 1).Insert
    Next
    S2ER = .Range("O65536").End(xlUp).Row
    .Range("O2:O" & S2ER).NumberFormatLocal = "@"
    .Range("O2:O" & S2ER).Offset(, 1).Copy
    .Range("O2").PasteSpecial (xlPasteValues)
    .Range("O2:O" & S2ER).Offset(, 1).Delete
    Application.Goto reference:=.Range("A1"), Scroll:=True
  End With
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub

0 hits

【22799】Sheet1のデータをSheet2に条件をつけて複... Sora 05/3/3(木) 18:26 質問
【22802】Re:Sheet1のデータをSheet2に条件をつけて... G-Luck 05/3/3(木) 19:02 発言
【22804】Re:Sheet1のデータをSheet2に条件をつけて... ichinose 05/3/3(木) 19:57 発言
【22806】Re:Sheet1のデータをSheet2に条件をつけて... ponpon 05/3/3(木) 22:52 発言
【22816】Re:Sheet1のデータをSheet2に条件をつけて... Sora 05/3/4(金) 10:56 質問
【22818】Re:Sheet1のデータをSheet2に条件をつけて... Jaka 05/3/4(金) 13:00 回答
【22838】間違えました。 Jaka 05/3/4(金) 17:31 回答
【22819】Re:Sheet1のデータをSheet2に条件をつけて... ichinose 05/3/4(金) 13:04 発言
【22845】Re:Sheet1のデータをSheet2に条件をつけて... Sora 05/3/4(金) 19:07 お礼

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