[[20181229112524]]　『区分ごとに並び替え』（前）　ページの最後に飛ぶ

『区分ごとに並び替え』（前）

 お世話になります。
 区分ごとの名簿をD列の集計列に区分1、区分2、区分3の順番で並べるにはどうすれば良いですか？

    A       B      C      D
 1 区分1   区分2   区分3   集計
 2  a       c      e      a
 3  b       d      f      b
 4                        c
                          d
                          e
                          f

 また、下のように区分1に"g"が追加されたら集計列もbとcの間に入るようにしたいです。

    A       B      C      D
 1 区分1   区分2   区分3   集計
 2  a       c      e      a
 3  b       d      f      b
 4  g                     g
                          c
                          d
                          e
                          f

 よろしくお願いします。

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

 掟破りのユーザー定義関数！
ちょっと多めに範囲を選択して、

 表示する時もちょっと多めに範囲を選択した状態でCtrl＋Shift＋Enterで確定します。
一応↓こんな感じになりました(^^;

 =集計(A2:C7)
区分1	区分2	区分3	集計	
a	c	e	a	a　=集計(A2:C7)
b	d	f	b	b
g	ア	D社	c	g
	ｆ		d	c
			e	d
			f	ア
				ｆ
				e
				f
				D社
				#N/A
				#N/A
				#N/A
				#N/A
				#N/A

 Option Explicit
Function 集計(ByVal 範囲 As Range) As Variant
Dim MyA As Variant
Dim MyAry() As Variant
Dim i As Long
Dim j As Long
Dim k As Long
MyA = 範囲.Value
For j = LBound(MyA, 2) To UBound(MyA, 2)
    For i = LBound(MyA, 1) To UBound(MyA, 1)
        If MyA(i, j) <> "" Then
            k = k + 1
            ReDim Preserve MyAry(1 To k)
            MyAry(k) = MyA(i, j)
        End If
    Next
Next
集計 = Application.Transpose(MyAry)
End Function

 そりゃないぜ！セニョーラ！セニョリータ！
v(=∩_∩=)v
（SoulMan） 2018/12/29(土) 14:07

 こんにちは　＾＾
めっちゃ力わざですけど。。。ＶＢＡ
シート2も作業でつかいましたので。。。まるごとふっとびます（消える）＾＾；
buf2の初期化は無駄かもですが（。。。用心の為　A^_^;）
新規ＢＯＯＫでお試しを

 Option Explicit
Sub main()
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim buf
    Dim buf2()
    Dim rr As Range
    Dim r As Range
    Dim y As Long
    Dim i As Long
    Dim j As Long
    Set s1 = Worksheets("Sheet1")
    Set s2 = Worksheets("Sheet2")
    s1.Columns(4).SpecialCells(2).Clear
    s2.UsedRange.Delete
    s1.UsedRange.Copy s2.Range("A1")
    s1.Columns(4).Cells(1) = "集計"
    With s2
        y = 2
        .Rows(1).Delete
        Set rr = s2.UsedRange
        For Each r In rr.Columns
            Debug.Print r.Address
            buf = r.SpecialCells(xlCellTypeVisible)
            If TypeName(buf) = "Variant()" Then
                For i = 1 To UBound(buf, 1)
                    If buf(i, 1) <> "" Then
                        ReDim Preserve buf2(j)
                        buf2(j) = buf(i, 1)
                        j = j + 1
                    End If
                Next
                s1.Cells(y, 4).Resize(UBound(buf2) + 1, 1) = WorksheetFunction.Transpose(buf2)
                y = y + UBound(buf2) + 1
            ElseIf TypeName(buf) = "String" Then
                s1.Cells(y, 4) = buf
                y = y + 1
            End If
            j = 0: Erase buf2
        Next
    End With
End Sub
（隠居じーさん） 2018/12/29(土) 14:38

 数式でやろうと思ったんだけど。

 tb1 = Application.Transpose(Range("A2", Range("A" & Rows.Count).End(xlUp)).Value)
 tb2 = Application.Transpose(Range("B2", Range("B" & Rows.Count).End(xlUp)).Value)
 tb3 = Application.Transpose(Range("C2", Range("C" & Rows.Count).End(xlUp)).Value)
 tb4 = Split(Join(tb1) & " " & Join(tb2) & " " & Join(tb3))
 Range("D2").Resize(UBound(tb4) + 1).Value = Application.Transpose(tb4)
（BJ） 2018/12/29(土) 14:52

 うわ～～～マジックナンバー。。。ならぬ
マジックコード（わるさはしないと思いますが、余分なものが　＾＾；）

 （隠居じーさん） 2018/12/29(土) 14:38の

 Debug.Print r.Address

 は消してくださいね
m(_ _)m

 すみません。
来年はあやまらなくてすむようにしよぉ～（できないかも）(#^.^#)

 (￣▽￣)；
（隠居じーさん） 2018/12/29(土) 15:17

 #N/Aが見苦しい場合は、↓こうすると消えました(^^;
数合わせしてね
=IF(COUNTA(集計(A2:C16))<ROW()-1,"",集計(A2:C16))

 区分1	区分2	区分3	集計	
a	c	e	a	a=IF(COUNTA(集計(A2:C16))<ROW()-1,"",集計(A2:C16))
b	d	f	b	b
g	ア	D社	c	g
ｓｓ	ｆ	ｊ	d	ｓｓ
ｙ	ｑｑｑ		e	ｙ
	o		f	o
o	p			c
				d
				ア
				ｆ
				ｑｑｑ
				o
				p
				e
				f
				D社
				ｊ
（SoulMan） 2018/12/29(土) 15:44

＞#N/Aが見苦しい場合は、

SoulManさんのを少しさわってみました

 ＞ReDim Preserve MyAry(1 To k)

はやめて

 MyAry = Evaluate("transpose(if(a1:a" & Application.Caller.Count & "="""","""",""""))")

で、どうでしょうか。

（マナ） 2018/12/29(土) 16:36

 こんばんは！
ありがとうございます。
入れ物を　.Caller.Count　で数えるんですね？
Niceです。勉強になりました。ありがとうございます。
これなら
=集計(A2:C16)
だけでいいですね(^^;

 ↓あってますぅ？
 Option Explicit
Function 集計(ByVal 範囲 As Range) As Variant
Dim MyA As Variant
Dim MyAry() As Variant
Dim i As Long
Dim j As Long
Dim k As Long
MyA = 範囲.Value
MyAry = Evaluate("transpose(if(a1:a" & Application.Caller.Count & "="""","""",""""))")
For j = LBound(MyA, 2) To UBound(MyA, 2)
    For i = LBound(MyA, 1) To UBound(MyA, 1)
        If MyA(i, j) <> "" Then
            k = k + 1
            MyAry(k) = MyA(i, j)
        End If
    Next
Next
集計 = Application.Transpose(MyAry)
End Function
（SoulMan） 2018/12/29(土) 17:04

 で、私風に書くと、、、
Option Explicit
Function 集計(ByVal 範囲 As Range) As Variant
Dim MyA As Variant
Dim MyAry() As String
Dim i As Long
Dim j As Long
Dim k As Long
MyA = 範囲.Value
ReDim MyAry(1 To Application.Caller.Count)
'MyAry = Evaluate("transpose(if(a1:a" & Application.Caller.Count & "="""","""",""""))")
For j = LBound(MyA, 2) To UBound(MyA, 2)
    For i = LBound(MyA, 1) To UBound(MyA, 1)
        If MyA(i, j) <> "" Then
            k = k + 1
            MyAry(k) = MyA(i, j)
        End If
    Next
Next
集計 = Application.Transpose(MyAry)
End Function
（SoulMan） 2018/12/29(土) 17:24

名簿なので String型でよかったですね。

（マナ） 2018/12/29(土) 17:51

 そうですね(^^;
私も　Caller.Count　を失念しておりました。
大変勉強になりました。
ありがとうございます。
これからもよろしくお願いします。
（SoulMan） 2018/12/29(土) 18:13

 大変遅くなり申し訳ございません。
 皆様ありがとうございます。ユーザー定義関数の知識がなく、最初は ？ でしたが、無事再現出来ました。SoulManさんありがとうございました。

 ひとつだけ、BJさんのコードはどこに入力すれば良いのでしょうか？シートモジュールと標準モジュールにそれぞれ入れてみましたが、どうすれば動くのかわかりません。
 申し訳ございませんがご教授お願いします。
（前） 2018/12/30(日) 11:36

 標準モジュール

 sub ・・・・
 end sub は、書いてません。
 （コピペでポンコードは、あまり書かないので、ほぼコピペでポンコードだけど）

（BJ） 2018/12/30(日) 12:36

 ありがとうございます。VBAでしたら当たり前のことでした。
 失礼しました。
（前） 2018/12/30(日) 12:54

コメント返信：

[ 一覧(最新更新順) ]

[[20181229112524]] 『区分ごとに並び替え』（前） ページの最後に飛ぶ

[[20181229112524]]　『区分ごとに並び替え』（前）　ページの最後に飛ぶ