Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

58644 / 76738

←次へ　｜　前へ→


	【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