Excel VBA質問箱 IV

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

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


22933 / 76738 ←次へ | 前へ→

【59177】Re:グループ分けをしたいのですが
発言  Yuki  - 08/12/1(月) 13:42 -

引用なし
パスワード
   ▼smasa さん:
>
>重複した数字がある行を判別してグループにし、
>結果をN列に表示したいのですが。
>お力をお貸しいただけないでしょうか?
>
>結果的には、下の例のように、G5:K10までの範囲にある数字を
>以下のようにN列に表示したいのです。
>
>>>    G H I J K ... M  N
>>> 5    1          1,2,3,4
>>> 6    2 3        1,2,3,4
>>> 7    5          5,6
>>> 8    3 4        1,2,3,4
>>> 9   1 2        1,2,3,4
>>>10   5 6        5,6 
>>>11
>
>行方向は空白セルでとまるようにします。(例の場合は10まで)
>
>もともとは下のように数字が入力されています。
>(1番左は行番号です)
>
>          列
>>>    G H I J K ... M N
>>> 5    1        
>>> 6    2 3       
>>> 7    5        
>>> 8    3 4       
>>> 9   1 2       
>>>10   5 6      
>
上記のデータだとして
こんな感じですか?
Option Explicit

Sub Macro1()
  Dim eRow  As Long
  Dim v  As Variant
  Dim i  As Long
  Dim j  As Long
  Dim x  As Long
  Dim A() As Variant
  Dim rng As Range
  Dim D  As Variant
  
  eRow = Range("G" & Rows.Count).End(xlUp).Row
  Set rng = Range("N1:N" & eRow)
  rng.Cells(1) = 1
  rng.DataSeries xlColumns
  Set rng = Nothing
  
  Set rng = Range("G1:N" & eRow)
  rng.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
       SortMethod:=xlPinYin, DataOption1:=xlSortNormal
      
  v = Range("G2:K" & eRow).Value
  
  rng.Sort Key1:=Range("L2"), Order1:=xlAscending, Header:=xlGuess, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
       SortMethod:=xlPinYin, DataOption1:=xlSortNormal
  
  Columns(14).ClearContents
  
  For i = 1 To UBound(v)
    If v(i, 2) = Empty Then
      x = x + 1
      ReDim Preserve A(1 To x)
      A(x) = v(i, 1)
    Else
      For j = 1 To UBound(v, 2)
        If v(i, j) = Empty Then Exit For
        ' 連番の時の処理
        If v(i, j) = Split(A(x), ",")(UBound(Split(A(x), ","))) + 1 Then
          A(x) = A(x) & "," & v(i, j)
        Else
'          ' 連番で無い時のは何でもグループにいれてしまう?
'          A(x) = A(x) & "," & v(i, j)
        End If
      Next
    End If
  Next

  v = Range("G2:N" & eRow).Value
  For i = 1 To UBound(v)
    For j = 1 To UBound(A)
      D = Split(A(j), ",")
      For x = 0 To UBound(D)
        If CStr(v(i, 1)) = D(x) Then
          v(i, 8) = A(j)
          Exit For
        End If
      Next
    Next
  Next
  Range("G2").Resize(UBound(v), UBound(v, 2)).Value = v
End Sub

0 hits

【59162】グループ分けをしたいのですが smasa 08/11/30(日) 23:35 質問
【59163】Re:グループ分けをしたいのですが かみちゃん 08/11/30(日) 23:38 発言
【59167】Re:グループ分けをしたいのですが ichinose 08/12/1(月) 8:46 発言
【59186】Re:グループ分けをしたいのですが smasa 08/12/1(月) 20:02 お礼
【59177】Re:グループ分けをしたいのですが Yuki 08/12/1(月) 13:42 発言

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