ここから本文です

VBA 特定の範囲指定されたセルをグループ単位で並び替えしたい VBA初心者です。...

h_m********さん

2017/3/2410:30:28

VBA 特定の範囲指定されたセルをグループ単位で並び替えしたい

VBA初心者です。
とある処理を、VBAで作ろうとして悩んでいます。

(Excel2010 VBA7.0)

前提
A:Cに各グループ(A列で数字が同じもの)単位でソートされた表があります。
D:Fは最初空白です。

やりたいこと
1.C:Cの中で一番数の多いものを検索(FindのApplication.Maxで検索)
2.一番数の多いものが含まれたグループを範囲指定(Unionを使ってます)
3-1.D:FにCopy/Paste(結果的に並び替えれればなんでも…)
(3-2.Copyした範囲を削除し↑詰め)
4.A:Cがなくなるまで、D:Fの下に1~3を繰り返す(For~Next)

初心者ながら、サイトで転がっているものをつぎはぎして作ってみたところ、Set CellFind = .Offset(1, 0)のところで止まってしまいます。
まず、この処理が何をしてるのかご教授頂けないでしょうか。また、解決するにはどこを直したらよいでしょうか。

---
sub narabikae ()
Set CellFind = Range("C:C").Find(What:=Application.Max(Range("C:C")), LookIn:=xlValues, LookAt:=xlWhole).Offset(0, -2)
For Repeat = CellFind.Row To Cells(Rows.Count, 1).End(xlUp).Row
With Cells(Repeat, 1)
If .Value = .Offset(1, 0).Value Then
Set CellFind = Union(CellFind, .Offset(1, 0))
Else
Application.DisplayAlerts = False
Range(CellFind, CellFind.Offset(0, 2)).Copy Destination:=Cells(Rows.Count, "D").End(xlUp).Offset(0, 0)
Range(CellFind, CellFind.Offset(0, 2)).Delete Shift:=xlUp
Application.DisplayAlerts = True
Set CellFind = .Offset(1, 0) '←止まってしまう
End If
End With
Next
End Sub
---

Set CellFind,CellFind.Offset,Application.Max,C&quot,Rows.Count,GroupCount,A&quot

閲覧数:
54
回答数:
1
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

nag********さん

2017/3/2411:41:35

コード例です。


Option Explicit
Sub Sample()
Dim PastePos As Long
Dim MaxValue As Long
Dim GroupCell As Range, GroupCount As Long

'D列の貼り付け位置を初期設定する
PastePos = 1

'A列がすべて空欄になるまで繰り返す
Do Until WorksheetFunction.CountA(Columns("A")) = 0

'C列のうちで最大の数を取得する
MaxValue = WorksheetFunction.Max(Columns("C"))

'最大の数のグループ番号をもつ先頭セルを求める
Set GroupCell = Columns("C").Find(What:=MaxValue, LookIn:=xlValues, LookAt:=xlWhole).Offset(, -2)

'そのグループ番号をもつデータの件数を求める
GroupCount = WorksheetFunction.CountIf(Columns("A"), GroupCell.Value)

'同じグループ番号をもつデータのセル範囲を切り取る
GroupCell.Resize(GroupCount, 3).Cut

'D列に張り付ける
Range("D" & PastePos).Select
ActiveSheet.Paste

'D列の貼り付け位置を更新する
PastePos = PastePos + GroupCount

Loop

'A列からC列を削除する
Range("A:C").Delete

End Sub

コード例です。


Option Explicit
Sub Sample()
 Dim PastePos...

  • 質問者

    h_m********さん

    2017/3/2412:13:32

    早速の回答ありがとうございます。

    解説まで丁寧に入れて頂き勉強になります。
    希望通りの動きになりました。

    offsetの短縮や、option Explicitは初めて知りました。
    もっと精進したいと思います。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる