Excel VBA質問箱 IV

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

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


2979 / 13646 ツリー ←次へ | 前へ→

【64902】列によるソート もーはん 10/3/25(木) 22:10 質問[未読]
【64903】Re:列によるソート kanabun 10/3/25(木) 23:10 発言[未読]
【64947】Re:列によるソート もーはん 10/3/29(月) 10:09 質問[未読]
【64951】Re:列によるソート kanabun 10/3/29(月) 13:18 発言[未読]
【64953】Re:列によるソート もーはん 10/3/29(月) 15:47 発言[未読]
【64954】Re:列によるソート kanabun 10/3/29(月) 16:42 発言[未読]
【64961】Re:列によるソート もーはん 10/3/30(火) 13:02 発言[未読]
【64962】Re:列によるソート kanabun 10/3/30(火) 14:03 発言[未読]
【64965】Re:列によるソート もーはん 10/3/30(火) 17:29 お礼[未読]
【64958】Re:列によるソート Hirofumi 10/3/29(月) 23:31 回答[未読]

【64902】列によるソート
質問  もーはん  - 10/3/25(木) 22:10 -

引用なし
パスワード
   シート1に
  A B C D E F
1 1 あ     
2 2 い    1 う
3 4 え
4 5 お    3 か
5       4 き
6 7 く
7 8 け    5 こ

とあったとして、
ソートをした際に

  A B C D E F
1 1 あ       
2       1 う
3 2 い    
4       3 か
5 4 え
6       4 き
7 5 お
8       5 こ
9 7 く
10 8 け

のような事はできますか?

【64903】Re:列によるソート
発言  kanabun  - 10/3/25(木) 23:10 -

引用なし
パスワード
   ▼もーはん さん:

[E:F]列のデータを [A:B]列に移動してしまえば
ふつうにソートできますよね?
で、
[E:F]列のデータには自分がE:F列から移動してきたデータだという
「しるし」を付けておいて、
[A:B]列で並び替えておいてから、しるしのあるデータだけ、
元の列に戻せばいいわけです。

下の例では、この「マーキング」に、
Rangeオブジェクトに IDプロパティというのを利用しています。

Option Explicit

Sub Try1()
  Dim c As Range
  Dim r As Range
  Set r = ActiveSheet.UsedRange.Resize(, 6)
  For Each c In r.Columns(5).Cells
    'E列データであることをIDプロパティにメモしておく
    c.ID = "E"
  Next
  '[E:F]列を [A:B]列に移動
  r.Columns(5).Resize(, 2).Cut r.Item(r.Rows.Count + 1, 1)
  '[A:B]列データを A列をキーにしてSort
  Set r = ActiveSheet.UsedRange.Resize(, 2)
  r.Sort r.Columns(1), Header:=xlNo
  
  '[A]列データのうちIDのあるものを 元のE列に戻す
  For Each c In r.Columns(1).Cells
    If Len(c.ID) Then
      c.Resize(, 2).Cut c.Offset(, 4)
    End If
  Next
  
End Sub

【64947】Re:列によるソート
質問  もーはん  - 10/3/29(月) 10:09 -

引用なし
パスワード
   kanabunさん 
返事が遅くなりすいません。

IDプロパティというのが色々調べましたが、イマイチ分からない状態です。
また、

  A B C D E  F
1 1 あ     
2 2 い    1  う
3 4 え    2  お
4        1.5 か
5       3  き 
6        3.5 こ



  A B C D E  F
1 1 あ    1  う   
2        1.5 か
3 2 い    2  お        
4       3  き 
5        3.5 こ
6 4 え

と、前回より複雑な処理も可能でしょうか?

【64951】Re:列によるソート
発言  kanabun  - 10/3/29(月) 13:18 -

引用なし
パスワード
   ▼もーはん さん:
こんにちは
>
>IDプロパティというのが色々調べましたが、イマイチ分からない状態です。
元のデータ位置(E列)をメモしておけるものなら、
IDプロパティでなくても、なんでもいいです。
たとえば、Comment でもいいです。


>と、前回より複雑な処理も可能でしょうか?

試してみられましたか?

【64953】Re:列によるソート
発言  もーはん  - 10/3/29(月) 15:47 -

引用なし
パスワード
   kanabun さんへ

はい。試してみて、ソートで並び換えが出来、
戻した後も、小さい順に並んでいるのですが、
同じ数字通しは、同じ行にはなっていない状態です。

それを同じ行にしたいのです。

【64954】Re:列によるソート
発言  kanabun  - 10/3/29(月) 16:42 -

引用なし
パスワード
   ▼もーはん さん:
>kanabun さんへ
>
>はい。試してみて、ソートで並び換えが出来、
>戻した後も、小さい順に並んでいるのですが、
>同じ数字通しは、同じ行にはなっていない状態です。
>
>それを同じ行にしたいのです。

はは〜、そういうことでしたか?

Try1()をすこし改良し、こんなのでは?

Sub Try2()
  Dim i As Long
  Dim c As Range
  Dim r As Range
  Dim ok As Long
  
  Set r = ActiveSheet.UsedRange.Resize(, 6)
  For Each c In r.Columns(5).Cells
    'E列データであることをIDプロパティにメモしておく
    c.ID = "E"
  Next
  '[E:F]列を [A:B]列に移動
  r.Columns(5).Resize(, 2).Cut r.Item(r.Rows.Count + 1, 1)
  '[A:B]列データを A列をキーにしてSort
  Set r = ActiveSheet.UsedRange.Resize(, 2)
  r.Sort r.Columns(1), Header:=xlNo
  
  '[A]列データのうちIDのあるものを 元のE列に戻す
  For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    Set c = Cells(i, 1).Resize(, 2)
    If Len(c(1).ID) Then
      ok = 1
      If i > 1 Then
        If c(0, 1).Value = c(1, 1).Value Then ok = 0
      End If
      c.Cut c(ok, 5)
      If ok = 0 Then Rows(i).Delete
    End If
  Next
  
End Sub

なお、 変数c はRangeオブジェクトですが、
c(1,1) というのは c.Item(1,1) の簡略表記で、
たとえば、c が [A8:B8]セル範囲のことだとすると、
 c.Item(1,1) は [A8]セルのことで、
 c.Item(1,2) は [B8]セルを指します。
 c.Item(0,1) とは c(1,1)の一行上ですから、[A7]セルのことです。
Itemプロパティによって指定されるセルは
範囲の左上セルを(1,1) とする単一セルのことです。

【64958】Re:列によるソート
回答  Hirofumi  - 10/3/29(月) 23:31 -

引用なし
パスワード
   こんなのでは?

C列、G列を作業列に使用します

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim j As Long
  Dim lngRows1 As Long
  Dim lngRows2 As Long
  Dim vntData1 As Variant
  Dim vntData2 As Variant
  Dim strProm As String
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  With ActiveSheet
    'A列グループ、E列グループを先頭列で整列
    DataSort .Columns("A:B"), Range("A1")
    DataSort .Columns("E:F"), Range("E1")
    'A列グループ、E列グループの最終行を取得
    lngRows1 = .Cells(Rows.Count, "A").End(xlUp).Row
    lngRows2 = .Cells(Rows.Count, "E").End(xlUp).Row
    'A列グループのA列をC列にCopy、E列グループのE列をG列にCopyします
    .Columns("A").Copy Destination:=.Columns("C")
    .Columns("E").Copy Destination:=.Columns("G")
    'A列、E列を比較
    i = 1: j = 1
    vntData1 = .Cells(i, "A").Value
    vntData2 = .Cells(j, "E").Value
    'A列、E列が共に最終行に成るまで繰り返し
    Do Until IsEmpty(vntData1) And IsEmpty(vntData2)
      'A列が最終行に達したら
      If IsEmpty(vntData1) Then
        lngRows1 = lngRows1 + 1
        .Cells(lngRows1, "C").Value = vntData2
        j = j + 1
      'E列が最終行に達したら
      ElseIf IsEmpty(vntData2) Then
        lngRows2 = lngRows2 + 1
        .Cells(lngRows2, "G").Value = vntData1
        i = i + 1
      Else
        Select Case vntData1
          Case Is = vntData2 'A、E列の値が同じなら何もしない
            i = i + 1
            j = j + 1
          Case Is < vntData2 'A列だけに在る値
            'G列最終行にA列の値を追加
            lngRows2 = lngRows2 + 1
            .Cells(lngRows2, "G").Value = vntData1
            i = i + 1
          Case Else 'E列だけに在る値
            'C列最終行にE列の値を追加
            lngRows1 = lngRows1 + 1
            .Cells(lngRows1, "C").Value = vntData2
            j = j + 1
        End Select
      End If
      vntData1 = .Cells(i, "A").Value
      vntData2 = .Cells(j, "E").Value
    Loop
    'A列グループをC列で、E列グループをG列で整列
    DataSort .Columns("A:C"), Range("C1")
    DataSort .Columns("E:G"), Range("G1")
    'C列、G列を消去
    .Columns("C").ClearContents
    .Columns("G").ClearContents
  End With
    
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  MsgBox strProm, vbInformation
     
End Sub

Private Sub DataSort(rngScope As Range, _
          rngKey As Range, _
          Optional lngSortOrder As Long = xlAscending, _
          Optional lngOrientation As Long = xlTopToBottom)

  rngScope.Sort _
      Key1:=rngKey, Order1:=lngSortOrder, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=lngOrientation, SortMethod:=xlStroke

End Sub

【64961】Re:列によるソート
発言  もーはん  - 10/3/30(火) 13:02 -

引用なし
パスワード
   kanabun さんへ

内容はやりたいことズバリでした。
コードについてお聞きしたいのですが、

この部分のコードの意味が良く理解出来ません。お教え願います。
>    If Len(c(1).ID) Then
>      ok = 1
>      If i > 1 Then
>        If c(0, 1).Value = c(1, 1).Value Then ok = 0
>      End If
>      c.Cut c(ok, 5)
>      If ok = 0 Then Rows(i).Delete
>    End If
>  Next
>  
>End Sub

【64962】Re:列によるソート
発言  kanabun  - 10/3/30(火) 14:03 -

引用なし
パスワード
   ▼もーはん さん:
>kanabun さんへ
>
>内容はやりたいことズバリでした。
>コードについてお聞きしたいのですが、
>
>この部分のコードの意味が良く理解出来ません。お教え願います。
>>    If Len(c(1).ID) Then
>>      ok = 1
>>      If i > 1 Then
>>        If c(0, 1).Value = c(1, 1).Value Then ok = 0
>>      End If
>>      c.Cut c(ok, 5)
>>      If ok = 0 Then Rows(i).Delete
>>    End If
>>  Next
>>  
>>End Sub

>  '[A]列データのうちIDのあるものを 元のE列に戻す
   'Sort後のA列を一番下のデータセルから順に調べていきます
   '(なぜ下からかというと、行削除することがあるため)
>   For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
     '↓変数c に i行のA:B列分をセットします
>     Set c = Cells(i, 1).Resize(, 2)
     '↓c範囲のA列のIDに何か文字列が入っていたら、元の列に
     ' 戻す処理を行います
>     If Len(c(1).ID) Then
       '移動先行はi行のことと(i-1)行のことがあるので
       'その分岐をする変数ok の初期値を1にします
       '(ok=1 のときは 同じi行です)
>       ok = 1
>       If i > 1 Then
         '↑調査行が2行目以降のときだけ
         ' ↓ひとつ上のセルの値と同じかどうか、調べます
         '  同じであれば、変数okを 0 に代えます
>         If c(0, 1).Value = c(1, 1).Value Then ok = 0
>       End If
       '以上で、上のセルの値との比較が実行されました。
       '↓i行のA,B列範囲をCutしてE列に移動します。
         範囲c をCut して、範囲cから見て
         ok行目の5列目に範囲を移動します。
         (A列のi行の値が(i-1)行の値と同じなら ok = 0、
         ちがっていれば ok = 1 です)
         ok = 1 なら、いま調査しているi行のこと、
         ok = 0 なら、ひとつ上の(i-1)行へ、ということです。
>       c.Cut c(ok, 5)
       ' ↓ひとつ上の行へ移動したときは元のi行全体を削除します
>       If ok = 0 Then Rows(i).Delete
>     End If
>   Next '以上を1行目まで繰り返します

【64965】Re:列によるソート
お礼  もーはん  - 10/3/30(火) 17:29 -

引用なし
パスワード
   kanabun さんへ

分かり易く有り難う御座いました

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