[[20111229091627]]　『複数列の同一内容セルの行を揃えるマクロ』（初心者）　ページの最後に飛ぶ

『複数列の同一内容セルの行を揃えるマクロ』（初心者）

 宜しくお願いします。
 ソートの昇順で各下記並びになっているデータに付いて、
  A列　　B列
 1111    1111 
 1112    1112
 1114    1113
 1115    1115
 1116    1116
 1117    1118
 1118    1119

 一括で下記のように同一内容のセルの行を揃えたいのですが、
 どのようにしたら良いでしょうか？

 A列　　  B列
 1111    1111
 1112    1112
         1113
 1114    
 1115    1115
 1116    1116
 1117    
 1118    1118
         1119

 Windows7
 Excel2007

 VBAの一例

 Sub test()
Dim a, i As Long, ii As Long, w(), x As Object, n As Long
With Range("a1").CurrentRegion
    a = .Value
    With CreateObject("System.Collections.SortedList")
        For ii = 1 To UBound(a, 2)
            For i = 1 To UBound(a, 1)
                If Not IsEmpty(a(i, ii)) Then
                    If Not .Contains(a(i, ii)) Then
                        ReDim w(1 To UBound(a, 2) * 2, 1 To 1)
                    Else
                        w = .Item(a(i, ii))
                    End If
                    n = w(UBound(a, 2) + ii, 1) + 1
                    If UBound(w, 2) < n Then
                        ReDim Preserve w(1 To UBound(w, 1), 1 To n)
                    End If
                    w(ii, n) = a(i, ii)
                    w(UBound(a, 2) + ii, 1) = n
                    .Item(a(i, ii)) = w
                End If
            Next
        Next
        Set x = .Clone: n = 0
    End With
    With .Offset(, .Columns.Count + 1).Cells(1)
        .CurrentRegion.ClearContents
        For i = 0 To x.Count - 1
            w = x.GetByIndex(i)
            .Offset(n).Resize(UBound(w, 2), UBound(a, 2)).Value = _
            Application.Transpose(w)
            n = n + UBound(w, 2)
        Next
    End With
End With
Set x = Nothing
End Sub
(seiya)

seiya様

 ありがとうございます。
 やりたいことが完璧に実現できました。
 手動でやるとかなり時間がかかっていたので、
 助かりました。
 (初心者)

 上記でseiya様に教えていただいたマクロですが、
 たとえば、
  A列　　B列　　　C列　　　　　　D列　　　E列　　　F列
 1111    1111 　＊＊＊　　　　＊＊＊　　＊＊＊　　＊＊＊
 1112    1112
 1114    1113
 1115    1115
 1116    1116
 1117    1118
 1118    1119
 とあり、ABC列グループとDEF列グループで、３つとも合致するものの行を揃えるように
 応用したいのですが、複雑すぎて正直全く手が出ません。
 （ABCは、今日のデータで、DEFは、昨日のデータでお互いに比較できるものです）
 どなたか、ご教授をよろしくお願いします。

 (初心者)

 元データを具体的に提示して、結果をどのようにしたいのか解るように説明してください。
 (seiya)

seiya様

 ありがとうございます。
 やりたいことは、下記のとおりです。

　　　　　A列　　B列　　　C列　　　　　　D列　　　E列　　　F列
　1行目　果物　リンゴ　　10円　　　　　　果物　　すいか　　100円

  2行目　果物　みかん　　30円　　　　　　果物　　リンゴ　　10円
　3行目　果物　レモン　　30円　　　　　　果物　　リンゴ　　30円
　4行目　野菜　キャベツ　40円　　　　　　果物　　レモン　　30円
　5行目　野菜　イモ　　　20円　　　　　　野菜　キャベツ　　40円
　6行目　果物　イチゴ　　80円　　　　　　果物　イチゴ　　　70円
　7行目　野菜　トマト　　5円　　　　　　 果物　　イモ　　　30円

これを

 　　　A列　　B列　　　C列　　　　　　D列　　　E列　　　F列
　1行目　　　　　　　　　　　　　　　　　果物　　すいか　　100円
  2行目　果物　リンゴ　　10円　　　　　　果物　　リンゴ　　10円
　3行目　　　　　　　　　　　　　　　　　果物　　リンゴ　　30円
　4行目　果物　みかん　　30円
　5行目　果物　レモン　　30円　　　　　　果物　　レモン　　30円
　5行目　野菜　キャベツ　40円　　　　　　野菜　キャベツ　　40円
　6行目　野菜　イモ　　　20円　　　　　　
　7行目　果物　イチゴ　　80円　　　　　　 
　8行目　　　　　　　　　　　　　　　　　果物　イチゴ　　　70円　　　　　　　　
　9行目　野菜　トマト　　5円　　　　　　
　10行目　　　　　　　 　　　　　　　　　果物　　イモ　　　30円
　
　わかり辛いと思いますが、ABC列の内容とDEF列の内容が三つともあっている
　行を合わせたいのです。
　よろしくお願いします。

　（初心者）

 こんな感じすか？

 Sub test()
Dim a, i As Long, ii As Long, iii As Long
Dim w(), x, n As Long, txt As String
With Range("a1").CurrentRegion
    a = .Value
    With CreateObject("Scripting.Dictionary")
        For ii = 1 To UBound(a, 2) Step 3
            For i = 1 To UBound(a, 1)
                If Len(a(i, ii) & a(i, ii + 1) & a(i, ii + 2)) > 0 Then
                    txt = Join$(Array(a(i, ii), a(i, ii + 1), a(i, ii + 2)), ";;")
                    If Not .exists(txt) Then
                        ReDim w(1 To 3)
                        .Item(txt) = w
                    Else
                        w = .Item(txt)
                        ReDim Preserve w(1 To UBound(w, 1) + 3)
                    End If
                    For iii = 1 To 3
                        w(UBound(w) - 3 + iii) = a(i, iii + ii - 1)
                    Next
                    .Item(txt) = w
                End If
            Next
        Next
        x = .items: n = 0
    End With
    With .Offset(, .Columns.Count + 1).Cells(1)
        .CurrentRegion.ClearContents
        For i = 0 To UBound(x)
            .Offset(n).Resize(, UBound(x(i))).Value = x(i)
            n = n + 1
        Next
    End With
End With
End Sub
(seiya)

seiya様

 本当にお世話なりました。
 ありがとうございます。
　やりたいことができました。
 整理した列が、H,I,J,K,L,Mに出てきますが、
 不定期だと思うのですが、一部、N､O､PにもK,L.Mと同内容の
 セルが出てきます。
 どのような理由が考えられるでしょうか？
 やりたいことは出来ましたので、お時間があるときに、
 ご教授をよろしくお願いします。
 (初心者)

 1,2,3  4,5,6  という3列単位で連結した文字列を基準にしています。
 例
 果物;;リンゴ;;10円
 果物;;みかん;;30円

 これをキーとして、重複があれば同じ行に転記します。
 重複が3っつ以上になれば当然 NOP QRS ... と増えていきますよ？

 その辺の説明が無いので...
 (seiya)

seiya様

 わかりました。作業が効率化できます。
 本当にありがとうございました。

　（初心者）

コメント返信：

[ 一覧(最新更新順) ]

[[20111229091627]] 『複数列の同一内容セルの行を揃えるマクロ』（初心者） ページの最後に飛ぶ

[[20111229091627]]　『複数列の同一内容セルの行を揃えるマクロ』（初心者）　ページの最後に飛ぶ