Excel VBA質問箱 IV

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

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


56182 / 76736 ←次へ | 前へ→

【25312】Re:重複データを一行にまとめる
発言  ponpon  - 05/5/27(金) 20:31 -

引用なし
パスワード
   さくらさん。Hirofumiさん。こんばんは。
HirofumiさんのDictionaryにはかないませんが、
(まだ、Dictionaryは、会得していない)
一応私も作ったので、
フィルタオプションとオートフィルタでやってみました。

>データは千件を超えます。
オートフィルタだから時間がかかると思います。

試してみてください。
1行目には、項目が入っているものとします。

Sub test()
  Dim myTbl As Range
  Dim myR As Range
  Dim myVal As Variant
  
  Application.ScreenUpdating = False
  Set myTbl = Worksheets("sheet1").Range("A1").CurrentRegion
  Set myR = Worksheets("sheet1").Range("D1")
 
  'A列のユニークな値をD列に書き出す。
  myTbl.Columns(1).AdvancedFilter xlFilterCopy, copytorange:=myR, unique:=True
  myVal = Range("D2", Range("D65536").End(xlUp)).Value
  
  'オートフィルターで抽出sheet2に転記
  For i = 1 To UBound(myVal, 1)
    myTbl.AutoFilter field:=1, Criteria1:=myVal(i, 1)
    Range("B2", Range("B65536").End(xlUp)).Copy
    With Worksheets("sheet2")
     .Range("A1:B1").Value = Worksheets("sheet1").Range("A1:B1").Value
     .Range("A65536").End(xlUp).Offset(1, 0).Value = myVal(i, 1)
     .Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial _
     Paste:=xlPasteAll, Transpose:=True
    End With
    myTbl.AutoFilter
  Next
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

0 hits

【25308】重複データを一行にまとめる さくら 05/5/27(金) 14:41 質問
【25310】Re:重複データを一行にまとめる Hirofumi 05/5/27(金) 19:49 回答
【25312】Re:重複データを一行にまとめる ponpon 05/5/27(金) 20:31 発言
【25314】Re:重複データを一行にまとめる だるま 05/5/27(金) 21:52 回答
【25369】Re:重複データを一行にまとめる さくら 05/5/30(月) 9:21 お礼

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