[[20150414135418]]　『データの並び替えについて』（ぽこぽこ）　ページの最後に飛ぶ

『データの並び替えについて』（ぽこぽこ）

素人のため力を貸してください。

EXCELにて、下記の「データ整列前」から「データ整列後」の形にデータの抽出・並べ替えを行いたいです。
行数が8万行ぐらいあります。
関数・マクロ等を組める方、やり方をご教示下さい。
また、こうしたほうがいいよというアドバイスありましたら、よろしくお願いします。

【やりたいこと】
A列に重複した番号がある場合、B～E列は重複している番号の最も下の行のデータを採用する。
採用されたデータを抽出し、最後に1行に整列する。

　＜データ整列前＞
　
　A列　　　　B列　　　　C列　　　　 D列　　　　E列
　番号　　　データ　　　データ　　　データ　　　データ
　１　　　　　100　　　　200　　　　200　　　　　100　　　　　
　２　　　　　300　　　　200　　　　500　　　　　500
　１　　　　　300
　３　　　　200　　　　300　　　　350　　　　　600
　１　　　　　　　　　　　　　　　　500

　※例：A列で番号１が重複している。
　　　番号１かつB列でもっとも下の行は３００なので３００を採用。
　　　番号１かつC列でもっとも下の行は200、D列は500、E列は100を採用。

　＜データ整列後＞

　A列　　　　B列　　　　C列　　　　 D列　　　　E列
　番号　　　データ　　　データ　　　データ　　　データ
　１　　　　　300　　　　200　　　　500　　　　　100
　２　　　　　300　　　　200　　　　500　　　　　500
　３　　　　 200　　　　300　　　　350　　　　　600

　※例：番号１の採用されたデータを一行に並べる。

以上、よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

	A	B	C	D	E	F	G	H	I	J	K
1	番号	データ	データ	データ	データ		番号	データ	データ	データ	データ
2	1	100	200	200	100		1	300	200	500	100
3	2	300	200	500	500		2	300	200	500	500
4	1	300					3	200	300	350	600
5	3	200	300	350	600						
6	1			500							
7

 G2 =IF(G1="","",IF(MAX(A:A)=G1,"",SMALL(A:A,COUNTIF(A:A,"<="&G1)+1)))
 H2 =IF($G2="","",LOOKUP(1,0/(($A$2:$A$80000=$G2)*(B$2:B$80000)),B$2:B$80000))

 H2をK2までコピー。

 G2:K2 下へコピー。
　
（GobGob） 2015/04/14(火) 14:50

 補足

 B:E列「0」には非対応
　
（GobGob） 2015/04/14(火) 14:51

 一応、ゼロ、マイナス値に対応

 H2 =IF($G2="","",LOOKUP(1,0/(($A$2:$A$80000=$G2)*(B$2:B$80000<>"")),B$2:B$80000))
　
（GobGob） 2015/04/14(火) 14:53

この短時間での適切な回答、すごすぎです。
まことにありがとうございました！

ただ、私の配慮が足りず、伝え切れていなかった部分があるため再度投稿させていただきます。

解るようでしたら再度回答をしていただければ幸いです。
（ぽこぽこ） 2015/04/14(火) 17:31

【再質問】

『データの並び替えについて』（ぽこぽこ）

素人のため力を貸してください。

EXCELにて、下記の「整列前」から「整列後」の形にデータの抽出・並べ替えを行いたいです。
行数が8万行ぐらいあります。
関数・マクロ等を組める方、やり方をご教示下さい。
また、不可能な場合、可能になるアドバイスがありましたらよろしくお願いします。

【やりたいこと】
A列（英字1桁＋数字1桁～4桁）に重複したものがある場合、B～E列は重複しているセルの最も下の行の文字列を採用する。
採用された文字列を抽出し、最後に1行に整列する。

　＜整列前＞
　
　A列　　　　　　　 B列　　　　C列　　　　 D列　　　　E列
　数字＋番号　　文字列　　　文字列　　　文字列　　　文字列
　B１　　　　　　K10Z0　　　　V2B00　　　B2D00　　　　BV1004　　　　　
　B２　　　　　　K10Z0　　　　V2Q00　　　B2D00　　　　BV1004　　　　　
　B１　　　　　 Dh300
　B３　　　　　K10Z0　　　　V2BG0　　　B2D00　　　　BV1004　　　　　
　B１　　　　　　　　　　　　　　　　　　　GEEEE

　※例：A列で「B１」が重複している。
　　　「B１」かつB列でもっとも下の行は「Dh300」なので「Dh300」を採用。
　　　「B１」かつC列でもっとも下の行は「V2B00」、D列は「GEEEE」、E列は「BV1004」を採用。

　＜整列後＞

A列　　　　　　　 B列　　　　C列　　　　 D列　　　　E列
　数字＋番号　　文字列　　　文字列　　　文字列　　　文字列
　B１　　　　　　Dh300　　　　V2B00　　　GEEEE　　　　BV1004
　B２　　　　　　K10Z0　　　　V2Q00　　　B2D00　　　　BV1004　　　　　　　　　

  B３ 　　　　　 K10Z0　　　　V2BG0　　　B2D00　　　　BV1004　
　※例：「B１」の採用された文字列を一行に並べる。その他の英字1桁＋数字1桁～4桁も順番に並ぶ。
以上、よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

 最初の質問を改変しちゃうとその後の回答の辻褄があわへんよーなるで。
 なんで元にもどしました。

 てなことで。

	A	B	C	D	E	F	G	H	I	J	K
1	番号	データ	データ	データ	データ		番号	データ	データ	データ	データ
2	B１	K10Z0	V2B00	B2D00	BV1004		B１	Dh300	V2B00	GEEEE	BV1004
3	B２	K10Z0	V2Q00	B2D00	BV1004		B２	K10Z0	V2Q00	B2D00	BV1004
4	B１	Dh300					B３	K10Z0	V2BG0	B2D00	BV1004
5	B３	K10Z0	V2BG0	B2D00	BV1004						
6	B１			GEEEE

 G2 =IFERROR(INDEX(A$2:A$80000,SMALL(INDEX((MATCH(A$2:A$80000&"",A$2:A$80000&"",0)<>ROW(A$2:A$80000)-1)*10^16+ROW(A$2:A$80000)-1,),ROW(A1)))&"","")
 H2 =IF($G2="","",LOOKUP(1,0/(($A$2:$A$80000=$G2)*(B$2:B$80000<>"")),B$2:B$80000))

（GobGob） 2015/04/15(水) 08:14

マクロ案です。８万行だと時間かかるかも。

 Sub test()
    Dim dic As Object
    Dim v, i As Long, s As String
    Dim ky, itm

    Set dic = CreateObject("scripting.dictionary")

    v = Sheets("Sheet1").Range("A1").CurrentRegion

    For i = 1 To UBound(v, 1)
        s = v(i, 1)
        If Not dic.exists(s) Then
            dic(s) = Array(Empty, Empty, Empty, Empty)
        End If

        dic(s) = Array(IIf(IsEmpty(v(i, 2)), dic(s)(0), v(i, 2)), _
                        IIf(IsEmpty(v(i, 3)), dic(s)(1), v(i, 3)), _
                        IIf(IsEmpty(v(i, 4)), dic(s)(2), v(i, 4)), _
                        IIf(IsEmpty(v(i, 5)), dic(s)(3), v(i, 5)))
     Next

    With Sheets("Sheet2").Range("A1")
        .CurrentRegion.ClearContents

        ky = dic.Keys
        itm = dic.Items

        For i = 0 To dic.Count - 1
            .Offset(i).Value = ky(i)
            .Offset(i, 1).Resize(, 4).Value = itm(i)
        Next

        .CurrentRegion.Sort Key1:=.Columns(1), Header:=xlNo
        Application.Goto .Cells(1)

    End With

    MsgBox "並べ替え完了!"

 End Sub

（マナ） 2015/04/15(水) 20:48

ご回答の方法で問題が解決しました！
初めて利用しましたが、このサイト・回答者様のすごさに感動です。
まことにありがとうございました！
（ぽこぽこ） 2015/04/16(木) 13:06

私のマクロ案は、やはり時間かかりそうなので今晩さしかえます。

（マナ） 2015/04/16(木) 13:23

試してみたら８万行でも、考えていたほど、遅くはありませんでした。
というか、↓でも、少し速くなっただけでした。

 Sub test2()
    Dim dic As Object
    Dim v, r As Long, c As Long
    Dim i As Long, j As Long, s As String
    Dim n As Long
    Dim w()

    Set dic = CreateObject("scripting.dictionary")

    v = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 5)
    r = UBound(v, 1)
    c = UBound(v, 2)
    ReDim w(1 To r, 1 To c)

    For i = 1 To r
        s = v(i, 1)
        If Not dic.exists(s) Then
            n = n + 1
            dic(s) = n
            w(dic(s), 1) = s
        End If
        For j = 2 To c
            If Not IsEmpty(v(i, j)) Then w(dic(s), j) = v(i, j)
        Next
    Next

    With Sheets("Sheet2").Range("A1")
        .CurrentRegion.ClearContents
        .Resize(r, c).Value = w
        .CurrentRegion.Sort Key1:=.Columns(1), Header:=xlNo
        Application.Goto .Cells(1)
    End With

    MsgBox "並べ替え完了!"

 End Sub

（マナ） 2015/04/16(木) 20:49

コメント返信：

[ 一覧(最新更新順) ]

[[20150414135418]] 『データの並び替えについて』（ぽこぽこ） ページの最後に飛ぶ

[[20150414135418]]　『データの並び替えについて』（ぽこぽこ）　ページの最後に飛ぶ