Excel VBA質問箱 IV

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

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


1631 / 13644 ツリー ←次へ | 前へ→

【72963】データ数が変動するときの並び替えの設定 はる 12/10/18(木) 8:55 質問[未読]
【72966】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/18(木) 10:34 回答[未読]
【72970】Re:データ数が変動するときの並び替えの設定 はる 12/10/18(木) 12:56 質問[未読]
【72971】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/18(木) 13:26 回答[未読]
【72973】Re:データ数が変動するときの並び替えの設定 はる 12/10/18(木) 14:20 質問[未読]
【72977】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/18(木) 15:32 回答[未読]
【72979】Re:データ数が変動するときの並び替えの設定 はる 12/10/18(木) 15:48 お礼[未読]
【72972】Re:データ数が変動するときの並び替えの設定 UO3 12/10/18(木) 13:54 発言[未読]
【72978】Re:データ数が変動するときの並び替えの設定 はる 12/10/18(木) 15:41 質問[未読]
【72987】Re:データ数が変動するときの並び替えの設定 UO3 12/10/19(金) 12:52 発言[未読]
【72990】Re:データ数が変動するときの並び替えの設定 はる 12/10/19(金) 15:02 質問[未読]
【72991】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/19(金) 15:14 回答[未読]
【72992】Re:データ数が変動するときの並び替えの設定 UO3 12/10/19(金) 15:55 発言[未読]
【72993】Re:データ数が変動するときの並び替えの設定 はる 12/10/19(金) 16:58 質問[未読]
【72994】Re:データ数が変動するときの並び替えの設定 UO3 12/10/19(金) 17:47 発言[未読]
【72997】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 9:31 質問[未読]
【72998】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/22(月) 10:20 質問[未読]
【73000】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 11:19 質問[未読]
【73001】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/22(月) 11:49 回答[未読]
【73003】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 13:08 質問[未読]
【73005】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/22(月) 13:50 回答[未読]
【73007】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 14:09 質問[未読]
【73009】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/22(月) 14:31 回答[未読]
【73012】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 15:47 質問[未読]
【73013】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/22(月) 16:48 回答[未読]
【73014】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 17:24 質問[未読]
【73015】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/22(月) 19:52 回答[未読]
【73016】Re:データ数が変動するときの並び替えの設定 はる 12/10/23(火) 10:02 質問[未読]
【73017】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/23(火) 10:20 回答[未読]
【73018】Re:データ数が変動するときの並び替えの設定 はる 12/10/23(火) 10:47 お礼[未読]
【73019】Re:データ数が変動するときの並び替えの設定 ウッシ 12/10/23(火) 11:27 回答[未読]
【73020】Re:データ数が変動するときの並び替えの設定 はる 12/10/23(火) 11:46 お礼[未読]
【72999】Re:データ数が変動するときの並び替えの設定 UO3 12/10/22(月) 11:14 発言[未読]
【73002】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 13:01 お礼[未読]
【73008】Re:データ数が変動するときの並び替えの設定 UO3 12/10/22(月) 14:18 発言[未読]
【73010】Re:データ数が変動するときの並び替えの設定 はる 12/10/22(月) 15:30 お礼[未読]

【72963】データ数が変動するときの並び替えの設定
質問  はる  - 12/10/18(木) 8:55 -

引用なし
パスワード
   データ数が変動するときの並び替えについて質問があります。
以下のような条件があるとして並び替えを行います。

  A   B   C
1 名前  数値
2 A君  260
3 Yさん 320
4 G君  200
5 O君  150
6 Nさん 310
7 Mさん 330
8

そこで以下のようなマクロを組みました。
  Range("A2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  
  ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A7") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:B7")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With

しかしデータ数(列数)の増減があるためマクロ途中の「Add Key:=Range("A2:A7") 」と「.SetRange Range("A1:B7")」のところをデータの増減に合わせて処理できるようにしたいのですが,巧くいきませんでした。
どのようにすればよろしいでしょうか?
どなたかご教授願います。

【72966】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/18(木) 10:34 -

引用なし
パスワード
   こんにちは

こちらはExcel2003なので試せないですけど、

こんな感じでしょうか?

  Dim s As Range
  With Worksheets("Sheet1")
    .Sort.SortFields.Clear
    Set s = .Range("A1").CurrentRegion
    .Sort.SortFields.Add Key:=s _
      , SortOn:=xlSortOnValues _
      , Order:=xlAscending _
      , DataOption:=xlSortNormal
    With .Sort
      .SetRange s
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With


▼はる さん:
>データ数が変動するときの並び替えについて質問があります。
>以下のような条件があるとして並び替えを行います。
>
>  A   B   C
>1 名前  数値
>2 A君  260
>3 Yさん 320
>4 G君  200
>5 O君  150
>6 Nさん 310
>7 Mさん 330
>8
>
>そこで以下のようなマクロを組みました。
>  Range("A2").Select
>  Range(Selection, Selection.End(xlDown)).Select
>  Range(Selection, Selection.End(xlToRight)).Select
>  
>  ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
>  ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A7") _
>    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
>  With ActiveWorkbook.Worksheets("Sheet1").Sort
>    .SetRange Range("A1:B7")
>    .Header = xlYes
>    .MatchCase = False
>    .Orientation = xlTopToBottom
>    .SortMethod = xlPinYin
>    .Apply
>  End With
>
>しかしデータ数(列数)の増減があるためマクロ途中の「Add Key:=Range("A2:A7") 」と「.SetRange Range("A1:B7")」のところをデータの増減に合わせて処理できるようにしたいのですが,巧くいきませんでした。
>どのようにすればよろしいでしょうか?
>どなたかご教授願います。

【72970】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/18(木) 12:56 -

引用なし
パスワード
   ウッシさん返答頂きましてありがとうございます。

頂いたマクロをそのまま貼り付けて試したところ,「並び替えの参照が正しくありません」とエラーが発生して「.Apply」のところでデバッグがかかってしまいました。
(マクロに詳しくないので何が原因かが分からなかったです)

あと,教えていただいたマクロを少し変更すれば応用できるかと思い,質問のときに簡単な例を出してしまいました。
私のマクロ知識では教えていただいたマクロを変更できないので,実際に処理したいものを記載します。
実際は以下のようになっており,数値が入っている人を上に集めて名前を昇順に並び替え,数値が「0」の人を下に集めて昇順で並び替えたいです。

よろしくお願いします。

   A   B   C
1  名前  数値
2  A君  260
3  Yさん  0
4  G君  200
5  O君   0
6  Nさん 310
7  Mさん 330
8  Iさん  0
9  H君   0
10 B君  320
11 K君  150
12 T君   0

【72971】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/18(木) 13:26 -

引用なし
パスワード
   こんにちは

「.Apply」はExcel2003 のソートにはないので分かりません。

Excel2003 のコードでも使えるはずなので、

Sub test1()
  Dim s As Range
  Dim sh As Worksheet
  Set sh = Worksheets("Sheet1")
  Set s = sh.Range("A1").CurrentRegion
  With s.Offset(, 2).Columns(1)
    .Formula = "=IF(B1<>0,B1,"""")"
    .Value = .Value
    s.Resize(, 3).Sort _
      Key1:=sh.Range("C2"), Order1:=xlAscending, _
      Header:=xlYes, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin, _
      DataOption1:=xlSortNormal
    Intersect(s, .SpecialCells( _
      xlCellTypeConstants).EntireRow).Sort _
        Key1:=sh.Range("A2"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, _
        DataOption1:=xlSortNormal
    Intersect(s, .SpecialCells( _
      xlCellTypeBlanks).EntireRow).Sort _
        Key1:=sh.Range("A2"), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, _
        DataOption1:=xlSortNormal
    .ClearContents
  End With
End Sub

【72972】Re:データ数が変動するときの並び替えの...
発言  UO3  - 12/10/18(木) 13:54 -

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

こんにちは
私も2007以降のSortオブジェクト処理はなじめず、未だに2003までの
Sortメソッドコードを使っていますが、Sortオブジェクト処理方式であれば
アップされたコードはSample1の用になりますね。

もし、シート上に、この2列しか無ければ Sample2,Sample3でもOKですが。

Sub Sample1()
  Dim z As Long
  
  With Sheets("Sheet1")
    z = .Range("A" & .Rows.Count).End(xlUp).Row
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Columns("A"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
      .SetRange .Parent.Range("A1:B" & z)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
End Sub

Sub Sample2()
  
  With Sheets("Sheet1")
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Columns("A"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
      .SetRange Parent.Range("A1").CurrentRegion
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
End Sub

Sub Sample3()
  
  With Sheets("Sheet1")
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Columns("A"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
      .SetRange .Parent.Cells
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
End Sub

【72973】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/18(木) 14:20 -

引用なし
パスワード
   ウッシ さん

巧くできました。ありがとうございます。

1つ教えていただきたいのですが,コードで「Key1:=sh.Range("C2"), 」とありますがこのC2はどのような意味があるのでしょうか?

もし宜しければ,ご教授ください。

【72977】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/18(木) 15:32 -

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

>1つ教えていただきたいのですが,コードで「Key1:=sh.Range("C2"), 」とありますがこのC2はどのような意味があるのでしょうか?

こんにちは

B列が「0」のデータと「>0」の部分を別々にソートする必要があるので、C列に数式を入れて
2種類のデータ範囲を識別出来るようにしてから、それぞれの範囲をソートしています。

B列に「0」のデータが無いとエラーになりますから、判定文を追加して使って下さい。

【72978】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/18(木) 15:41 -

引用なし
パスワード
   UO3 さん

いつもお世話になります。

巧く動作しました。
ただ出来れば,実際は以下のようになっており,数値が入っている人を上に集めて名前を昇順に並び替え,数値が「0」の人を下に集めて昇順で並び替えたいです。

よろしくお願いします。

   A   B   C
1  名前  数値
2  A君  260
3  Yさん  0
4  G君  200
5  O君   0
6  Nさん 310
7  Mさん 330
8  Iさん  0
9  H君   0
10 B君  320
11 K君  150
12 T君   0

【72979】Re:データ数が変動するときの並び替えの...
お礼  はる  - 12/10/18(木) 15:48 -

引用なし
パスワード
   ウッシ さん

説明までしてくださりありがとうございました。
やっぱりマクロは奥が深いです。
色々と分からないことだらけなので,徐々にでも勉強していきます。

ありがとうございました。

【72987】Re:データ数が変動するときの並び替えの...
発言  UO3  - 12/10/19(金) 12:52 -

引用なし
パスワード
   ▼はる さん:
>ただ出来れば,実際は以下のようになっており,数値が入っている人を上に集めて名前を昇順に並び替え,数値が「0」の人を下に集めて昇順で並び替えたいです。

じゃぁ、ちょっとインチキ手抜きバージョンで。
A,B列しかないシートという前提で、C列を作業列に使います。
C列以降にもデータがあるということなら、もう少しまじめなコードにしますが。

Sub Sample4()
  Dim wkR As Range
  
  With Sheets("Sheet1")
  
    Set wkR = .Range("A1").CurrentRegion.Offset(, 2).Resize(, 1)
    wkR.Formula = "=IF(B1=0,1,0)"
    wkR(1).Value = "作業列"
    wkR.Value = wkR.Value
  
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=wkR.Columns(1), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=.Columns("A"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With .Sort
      .SetRange .Parent.Cells
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
  
  wkR.Clear
  
End Sub

【72990】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/19(金) 15:02 -

引用なし
パスワード
   UO3 さん

ご返答くださいましてありがとうございます。
教えていただいた手抜きバージョンってどこが手抜きなんですか?
私から見ればしっかりバージョンに見えます。。。

シートですが実はA,B列だけでなくF列まであります。

ウッシさんに教えていただいたコード,UO3さんに教えていただいたコードを少しいじれば対応できるかと甘い考えでやってみたのですが,巧く対応できませんでした。

もし宜しければF列までのバージョンをご教授ください。

【72991】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/19(金) 15:14 -

引用なし
パスワード
   こんにちは

F列というか、A列からの連続した範囲に対応しておきました。
判定対象列はそのままB列としてあります。
その列位置も変更するのでしたら、「"=IF(B1<>0,B1,"""")"」の部分を適宜変更して下さい。

Sub test2()
  Dim s As Range
  Dim sh As Worksheet
  Dim c As Long
  Set sh = Worksheets("Sheet1")
  Set s = sh.Range("A1").CurrentRegion
  c = s.Columns.Count
  With s.Offset(, c).Columns(1)
    .Formula = "=IF(B1<>0,B1,"""")"
    .Value = .Value
    s.Resize(, c + 1).Sort _
      Key1:=sh.Range("A2").Offset(, c), Order1:=xlAscending, _
      Header:=xlYes, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin, _
      DataOption1:=xlSortNormal
    Intersect(s, .SpecialCells( _
      xlCellTypeConstants).EntireRow).Sort _
        Key1:=sh.Range("A2"), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, _
        DataOption1:=xlSortNormal
    Intersect(s, .SpecialCells( _
      xlCellTypeBlanks).EntireRow).Sort _
        Key1:=sh.Range("A2"), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlPinYin, _
        DataOption1:=xlSortNormal
    .ClearContents
  End With
End Sub

【72992】Re:データ数が変動するときの並び替えの...
発言  UO3  - 12/10/19(金) 15:55 -

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

F列まであっても、それ以上あってもOKの【まじめバージョン】です。

Sub Sample5()
  Dim wkR As Range
  Dim x As Long
  Dim y As Long
  
  With Sheets("Sheet1")
    With .Range("A1").CurrentRegion
      x = .Columns.Count + 1
      y = .Rows.Count
    End With
    Set wkR = .Columns(x).Resize(y)
    wkR.Formula = "=IF(B1=0,1,0)"
    wkR.Cells(1).Value = "作業列"
    wkR.Value = wkR.Value
 
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=wkR.Columns(1), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=.Columns("A"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With .Sort
      .SetRange .Parent.Cells
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  End With
 
  wkR.Clear
 
End Sub

【72993】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/19(金) 16:58 -

引用なし
パスワード
   ウッシさん,UO3さん

ご返答くださいましてありがとうございます。

大変申し訳ございません。
まだ私の考えが甘かったです。

まだ少しお伝えしていないことがありまして,列が途中から始まっているのとその途中に空セルがあります。
やはり自分で対応しようとしても思うように動きませんでした。。。

もうそのまま記載します。
B4:E4とB5:D5はセルが結合されています。
A4とA6及びF1:F6は空セルです。

最終的な希望としては2つあり,
1.数値が入っている人を上に集めて名前を昇順に並び替え,数値が「0」の人を下に集めて昇順で並び替えたい。
2.H列〜L列を「1」で並び替えた人の並びにしたい

何度もお手間をお掛けして申し訳ございませんが,よろしくお願いいたします。
今からPCを閲覧できない環境になってしまうので,返信が月曜日以降となってしまいますことをご了承頂ければ幸いです。


   A   B   C   D   E   F   G   H   I   J
1
2
3
4          10月                   Total
5  名前      数値     数の        名前      数値
6     <1  1-10  10<  合計            <1  1-10
7  A君   2   10   1   13   13      O君  120・・・
8  Yさん  0   5   0   5   5      Yさん 100・・・
9  G君   5   0   11   16   16      Mさん 106・・・
10 O君   0   1   2   3   3      K君  200・・・
11 Nさん  3   1   2   6   6      Nさん  96・・・
12 Mさん  4   10   0   14   14      B君  162・・・
13 Iさん  0   0   15   15   15      H君  210・・・
14 H君   0   0   11   11   11      A君  155・・・
15 B君   2   1   0   3   3      G君  199・・・
16 K君   5   0   0   5   5      Iさん 132・・・

【72994】Re:データ数が変動するときの並び替えの...
発言  UO3  - 12/10/19(金) 17:47 -

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

なるほど・・・・
でも、やっぱり最初からきちんと説明されるべきでしたね。
そうすれば、もっと早く正解が得られたはずです。

説明いただいたことをベースに週末考えてみますが
まだ不明点もありますよ。

・F列にE列と同じ数字が並んでいるけど、これは何だろう?
・B〜F列は【値】? それとも、計算式もある?

まぁ、このあたりは、計算式ががいっていてもおそらくはOKでしょう。(想像)

でも、
H列〜L列には?ここは計算式のような予感ですが、この計算式によっては
処理構造が制約をうける可能性があります。
もしかしたら、ここは計算式ではなく、コード内で合計計算をして書き込む必要も
でてくるかもですね。

コードは↑の回答をもらってからでないと、推測で書きだしても無駄になりますので
月曜日(以降)の連絡をお待ちします。

【72997】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/22(月) 9:31 -

引用なし
パスワード
   UO3さん

おはようございます。

>でも、やっぱり最初からきちんと説明されるべきでしたね。
>そうすれば、もっと早く正解が得られたはずです。

申し訳ございませんでした。
最初から全てを聞いてしまうとコピペして少し修正して終了になってしまいそうで,ヒントを元にある程度自分でと思っていました。
皆さんのお手間等を考えるべきでした。すいません。

疑問に対する回答ですが,
1.計算式:今回のお願いしている表は別のところで計算させて持ってきていて
     全ての値に関して計算式は入っていません。
     H列以降に関しても同様です。
     
2.E列とF列:元の表はE列でB,C,D列の合計,F列で別の計算式で計算させ
       確認用としているため,同じ数字になります。

このような感じでご返答になっていますでしょうか?

何度もご面倒をお掛けしますが,よろしくお願いします。

【72998】Re:データ数が変動するときの並び替えの...
質問  ウッシ  - 12/10/22(月) 10:20 -

引用なし
パスワード
   こんにちは

>1.数値が入っている人を上に集めて名前を昇順に並び替え,数値が「0」の人を下に集めて昇順で並び替えたい。

数値が入っているという列はどこのことですか?

E列だとすると、例では数値「0」の人は居ないですよね。

どこを基準に並べ替えればいいのですか?

【72999】Re:データ数が変動するときの並び替えの...
発言  UO3  - 12/10/22(月) 11:14 -

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

それでは以下でお試しください。

Sub Sample6()
  Dim wkR As Range
  Dim myR As Range
  Dim y As Long
  Dim v() As Variant
  Dim dic As Object
  Dim c As Range
  Dim i As Long
  Dim j As Long
  
  With Sheets("Sheet1")
    y = .Range("A" & .Rows.Count).End(xlUp).Row
    Set myR = .Range("A7:G" & y)  '左側のデータ域
    Set wkR = myR.Columns(7)    'G列作業域
    wkR.Formula = "=IF(F7=0,1,0)"
    wkR.Value = wkR.Value
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=wkR, _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=.Columns("A"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With .Sort
      .SetRange myR
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    
    ReDim v(1 To y - 6, 1 To 5) '右側領域用配列
    Set dic = CreateObject("Scripting.Dictionary")
    
    For Each c In .Range("A7:A" & y)  '並び替えられたA列
      dic(c.Value) = dic.Count + 1  '1から順番に配列内行番号を割り振る
    Next
    
    For Each c In .Range("H7:H" & y)  '右側領域の人名セル抽出
      If dic.exists(c.Value) Then   'もし左側領域にあれば
        i = dic(c.Value)      '配列に納めるべき行番号
        For j = 1 To 5       'H列〜L列
          v(i, j) = c.Offset(, j - 1).Value
        Next
      End If
    Next
    
    .Range("H7").Resize(UBound(v, 1), UBound(v, 2)).Value = v
        
  End With

  wkR.Clear

End Sub

【73000】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/22(月) 11:19 -

引用なし
パスワード
   ウッシさん

こんにちは。
お世話になります。

そうですね。ウッシさんの仰るとおりで私の記載の仕方が良くなかったです。
記載した表はまだ下のほうにデータが入っていてそこでは「0」が入っています。
またしてもすいませんでした。
並び替える基準はE列でお願いします。

すいませんが,以下の場合でお願いします。


   A   B   C   D   E   F   G   H   I   J
1
2
3
4          10月                   Total
5  名前      数値     数の        名前      数値
6     <1  1-10  10<  合計            <1  1-10
7  A君   2   10   1   13   13      O君  120・・・
8  Yさん  0   0   0   0   0      Yさん 100・・・
9  G君   0   0   0   0   0      Mさん 106・・・
10 O君   0   1   2   3   3      K君  200・・・
11 Nさん  0   0   0   0   0      Nさん  96・・・
12 Mさん  4   10   0   14   14      B君  162・・・
13 Iさん  0   0   15   15   15      H君  210・・・
14 H君   0   0   11   11   11      A君  155・・・
15 B君   0   0   0   0   0      G君  199・・・
16 K君   5   0   0   5   5      Iさん 132・・・

【73001】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/22(月) 11:49 -

引用なし
パスワード
   こんにちは

H〜L列をソートすると書いて有りましたのでM列を作業列に使います。

Sub test3()
  Dim s As Range
  Dim t As Range
  Dim sh As Worksheet
  Dim c As Long
  Set sh = Worksheets("Sheet1")
  Set s = sh.Range("F7", sh.Cells(Rows.Count, "F").End(xlUp))
  c = 7  'F列からM列へのオフセット値
  With s.Offset(, c)
    .Formula = "=IF(F7<>0,F7,"""")"
    .Value = .Value
    
    Set t = .Offset(, -5).Resize(, 6)
    
    Call test_sort(t, "F1", xlNo)
      
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeConstants).EntireRow), "A1", xlNo)
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeBlanks).EntireRow), "A1", xlNo)
    .ClearContents
  End With
End Sub
Sub test_sort(Target As Range, Key As String, Header As XlYesNoGuess)
  With Target
    .Select
    .Sort _
      Key1:=.Range(Key), Order1:=xlAscending, _
      Header:=Header, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin, _
      DataOption1:=xlSortNormal
  End With
End Sub


▼はる さん:
>ウッシさん
>
>こんにちは。
>お世話になります。
>
>そうですね。ウッシさんの仰るとおりで私の記載の仕方が良くなかったです。
>記載した表はまだ下のほうにデータが入っていてそこでは「0」が入っています。
>またしてもすいませんでした。
>並び替える基準はE列でお願いします。
>
>すいませんが,以下の場合でお願いします。
>
>
>   A   B   C   D   E   F   G   H   I   J
>1
>2
>3
>4          10月                   Total
>5  名前      数値     数の        名前      数値
>6     <1  1-10  10<  合計            <1  1-10
>7  A君   2   10   1   13   13      O君  120・・・
>8  Yさん  0   0   0   0   0      Yさん 100・・・
>9  G君   0   0   0   0   0      Mさん 106・・・
>10 O君   0   1   2   3   3      K君  200・・・
>11 Nさん  0   0   0   0   0      Nさん  96・・・
>12 Mさん  4   10   0   14   14      B君  162・・・
>13 Iさん  0   0   15   15   15      H君  210・・・
>14 H君   0   0   11   11   11      A君  155・・・
>15 B君   0   0   0   0   0      G君  199・・・
>16 K君   5   0   0   5   5      Iさん 132・・・

【73002】Re:データ数が変動するときの並び替えの...
お礼  はる  - 12/10/22(月) 13:01 -

引用なし
パスワード
   UO3さん

期待していたとおりに動作することを確認しました。
ありがとうございます。

またコードに分かりやすく説明まで付けて下さり,重ねてお礼申し上げます。

まだまだ未熟者で勉強途中なので(全然進歩していないですが・・・),今後も手詰まりの際には質問させて頂くと思いますが,その時はよろしくお願いします。

【73003】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/22(月) 13:08 -

引用なし
パスワード
   ウッシさん

返信ありがとうございます。
コード途中の「End Sub」で止まってしまい作業が完了されませんでした。
想像では「End Sub」でなく,他のコードが入るのかと思うのですが・・・。

よろしくお願いします。

【73005】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/22(月) 13:50 -

引用なし
パスワード
   こんにちは

右側エリアだけ並べ替えるのかと思ってました。

Sub test4()
  Dim s As Range
  Dim t As Range
  Dim sh As Worksheet
  Const c As Long = 7
  Dim x As Long
  Set sh = Worksheets("Sheet1")
  Set s = sh.Range("A7", sh.Cells(Rows.Count, "A").End(xlUp))
  Set t = s.Resize(, c)
  With t.Columns(c)
    .Formula = "=IF(B7<>0,B7,"""")"
    .Value = .Value
    
    Call test_sort(t, "G1", xlNo, xlDescending)
      
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeConstants).EntireRow), "A1", xlNo, xlAscending)
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeBlanks).EntireRow), "A1", xlNo, xlAscending)
    .ClearContents
  End With
  
  Application.AddCustomList ListArray:=s.Value
  x = Application.CustomListCount
  With s.Offset(, c).Resize(, 5)
    .Select
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, _
      OrderCustom:=x + 1, MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin
  End With
  Application.DeleteCustomList ListNum:=x
  
End Sub
Sub test_sort(Target As Range, Key As String, Header As XlYesNoGuess, Order As XlSortOrder)
  With Target
    .Select
    .Sort _
      Key1:=.Range(Key), Order1:=Order, _
      Header:=Header, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin, _
      DataOption1:=xlSortNormal
  End With
End Sub

これでどうでしょうか?

【73007】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/22(月) 14:09 -

引用なし
パスワード
   ウッシさん

説明不足ですいません。
左側を数値が入っている人を上に集めて名前を昇順に並び替え,数値が「0」の人を下に集めて昇順で並び替え,その並び替えに合うように右側エリアも並べ替えたいです。

実行したところ,「該当するセルが見つかりません」とエラーが出てしまい,
Call test_sort(Intersect(t, .SpecialCells( _
       xlCellTypeConstants).EntireRow), "A1", xlNo, xlAscending)
のところで止まってしまいます。

ところでコード途中の
End Sub
Sub test_sort(Target As Range,・・・
はそのままでよろしいですか?

【73008】Re:データ数が変動するときの並び替えの...
発言  UO3  - 12/10/22(月) 14:18 -

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

いろいろアップすると混乱されるかもしれませんが・・・
もし、登場する名前に重複がない、かつ、左側の名前と右側の名前は順番以外は1:1だという前提なら
以下のように並び替えだけのコードでも大丈夫ですのでご参考まで。

Sub Sample6()
  Dim wkR1 As Range
  Dim myR1 As Range
  Dim wkR2 As Range
  Dim myR2 As Range
  Dim y As Long
 
  With Sheets("Sheet1")
    y = .Range("A" & .Rows.Count).End(xlUp).Row
    Set myR1 = .Range("A7:G" & y)  '左側のデータ域
    Set myR2 = .Range("H7:M" & y)  '右側のデータ域
    Set wkR1 = myR1.Columns(myR1.Columns.Count) '左側の作業域
    Set wkR2 = myR2.Columns(myR2.Columns.Count) '右側の作業域
    
    '左側領域を名前のみで並び替え
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Columns("A"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
      .SetRange myR1
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    '右側領域を名前のみで並び替え
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Columns("H"), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
      .SetRange myR2
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    
    wkR1.Formula = "=IF(F7=0,1,0)"
    wkR1.Value = wkR1.Value
    wkR2.Value = wkR1.Value
    
    '左側領域を数値有り無しで並び替え
    
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=wkR1, _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With .Sort
      .SetRange myR1
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    
    '右側領域を数値有り無しで並び替え
    
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=wkR2, _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With .Sort
      .SetRange myR2
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    
  End With

  wkR1.Clear
  wkR2.Clear

End Sub

【73009】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/22(月) 14:31 -

引用なし
パスワード
   こんにちは

>左側を数値が入っている人を上に集めて名前を昇順に並び替え,数値が「0」の人を下に集めて昇順で並び替え,
>その並び替えに合うように右側エリアも並べ替えたいです。

そのようにしてあります。

>実行したところ,「該当するセルが見つかりません」とエラーが出てしまい,
>Call test_sort(Intersect(t, .SpecialCells( _
>       xlCellTypeConstants).EntireRow), "A1", xlNo, xlAscending)
>のところで止まってしまいます。

B列に「0」以上のデータが入った行が無いとそのエラーになります。

>ところでコード途中の
>End Sub
>Sub test_sort(Target As Range,・・・
>はそのままでよろしいですか?

そのままでいいです。
確認しやすいように「Select」入れて有りますので F8キーでステップ実行してどこをソートしてるか確かめて下さい。

エラーの前の数式セットした状態で G列の値がどうなっているのか確認して下さい。
値の入った行と、空白の行がないとエラーになりますので、エラー回避のコードを追加して下さい。

【73010】Re:データ数が変動するときの並び替えの...
お礼  はる  - 12/10/22(月) 15:30 -

引用なし
パスワード
   UO3さん

ありがとうございます。
こちらもやりたいことが動作してくれました。

まだ内容を精査していないのでどちらがいいのかは分かりませんし,精査したところで私で分かるレベルかは分かりませんが,良さそうなほうを選びたいと思います。

今回も色々とありがとうございました。
また行き詰ったときには助言のほど,よろしくお願いいたします。

【73012】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/22(月) 15:47 -

引用なし
パスワード
   ウッシさん

返信ありがとうございます。

・B列に「0」しか入っていないこともあります。
 何とかなるでしょうか?
 (すいません,エラー回避のコードが良く分からないです。。。)

・「End Sub」に関しては理解しました。
 End Subがついていてもそのまま続いて実行できるのですね。
 勉強不足でEnd Subがあるとそこで実行が途切れるのだと思っていました。

・とりあえずB列の適当なところに「1」を入力し実行しましたが,うまく並び替えが行われなかったです。

何度も申し訳ございませんが,よろしくお願いします。

【73013】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/22(月) 16:48 -

引用なし
パスワード
   こんにちは

提示されたテストデータで確認しているので動くはずです。

ただし、右側エリアの並び替えにはユーザーリストを使っていますので、Excelのバージョンによってはダメなのかも・・・
こちらは Excel2003です。

SpecialCells を使っているので、データが有るか無いかどちらかだけのときのエラーだけ
回避すればいいと思いますので「On Error Resume Next」で簡単に済ませちゃってます。

Sub test5()
  Dim s As Range
  Dim t As Range
  Dim sh As Worksheet
  Const c As Long = 7
  Dim x As Long
  Set sh = Worksheets("Sheet1")
  Set s = sh.Range("A7", sh.Cells(Rows.Count, "A").End(xlUp))
  Set t = s.Resize(, c)
  With t.Columns(c)
    .Formula = "=IF(B7<>0,B7,"""")"
    .Value = .Value
    
    Call test_sort(t, "G1", xlNo, xlDescending)
    
    On Error Resume Next
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeConstants).EntireRow), "A1", xlNo, xlAscending)
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeBlanks).EntireRow), "A1", xlNo, xlAscending)
    On Error GoTo 0
    .ClearContents
  End With
  
  Application.AddCustomList ListArray:=s.Value
  x = Application.CustomListCount
  With s.Offset(, c).Resize(, 5)
    .Select
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, _
      OrderCustom:=x + 1, MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin
  End With
  Application.DeleteCustomList ListNum:=x
  
End Sub
Sub test_sort(Target As Range, Key As String, Header As XlYesNoGuess, Order As XlSortOrder)
  With Target
    .Select
    .Sort _
      Key1:=.Range(Key), Order1:=Order, _
      Header:=Header, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin, _
      DataOption1:=xlSortNormal
  End With
End Sub

> End Subがついていてもそのまま続いて実行できるのですね。
> 勉強不足でEnd Subがあるとそこで実行が途切れるのだと思っていました。

知らない事は誰でも知らないので大した事ではないです。
是非、F8キ−でステップ実行してみて下さい。
確認出来たら「.Select」しているコードはコメントアウトしていいです。

【73014】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/22(月) 17:24 -

引用なし
パスワード
   ウッシさん

返信ありがとうございます。
当方で試したところやはり巧く作動してくれませんでした。

ウッシさんのコードを実行すると以下のようになりました。
Excel2010だからですかね・・・?


  A   B   C   D   E   F   G   H   I   J
1
2
3
4          10月                   Total
5  名前      数値     数の        名前      数値
6     <1  1-10  10<  合計            <1  1-10
7  A君   2   10   1   13   13      K君  200・・・
8  K君   5   0   0   5   5      Mさん 106・・・
9  Mさん  4   10   0   14   14      B君  162・・・
10 B君   0   0   0   0   0      G君  199・・・ 
11 G君   0   0   0   0   0      H君  210・・・
12 H君   0   0   11   11   11      Iさん 132・・・
13 Iさん  0   0   15   15   15      Nさん  96・・・  
14 Nさん  0   0   0   0   0      O君  120・・・
15 O君   0   1   2   3   3      Yさん 100・・・
16 Yさん  0   0   0   0   0      A君  155・・・

【73015】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/22(月) 19:52 -

引用なし
パスワード
   こんばんは

並べ替える基準がB列だと勘違いしてました。

E列なんですね?

.Formula = "=IF(B7<>0,B7,"""")"



.Formula = "=IF(E7<>0,E7,"""")"

に変更して下さい。


ただ、右側エリアがソートされていないのが気になりますけど、自宅の2010で確かめたら
ちゃんとソートされてますので問題ないと思います。

F8キーでステップ実行して、

  Application.AddCustomList ListArray:=s.Value
  x = Application.CustomListCount
  With s.Offset(, c).Resize(, 5)
    .Select
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, _
      OrderCustom:=x + 1, MatchCase:=False, Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin
  End With
  Application.DeleteCustomList ListNum:=x

の「.Select」で右側エリアが選択されているか、
「 Application.DeleteCustomList ListNum:=x」の手前で止めてExcelのオプションの基本設定で
「並び替え順や連続データ入力設定で使用するリストを作成します」のユーザーリストの編集ボタンで
セルA7の「A君」以下の項目がリストに入っているか確認して下さい。

【73016】Re:データ数が変動するときの並び替えの...
質問  はる  - 12/10/23(火) 10:02 -

引用なし
パスワード
   ウッシさん

おはようございます。
返信ありがとうございます。

.Formula = "=IF(B7<>0,B7,"""")">

.Formula = "=IF(E7<>0,E7,"""")"
に変更したら左側は巧く動作してくれました。

しかし右側は同じようにA君だけ一番下に移動してしまいます。。。


ウッシさんから助言頂いたことも確認しました。
・Selectで右側が選択されていました。
・ユーザーリストの編集ではきちんと「$H$7:$J$16」が選ばれており,更にリストの中にもA君は含まれていました。

少し不思議なことが分かったので記載しておきます。
右のリストを手動で選択し,並べ替えを行ってもA君だけ違うところにいました。
(降順,昇順ではきちんと並びました)

【73017】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/23(火) 10:20 -

引用なし
パスワード
   こんにちは

そういう事ですか。

右側のエリアの「A君」の後ろにスペースが入っているのでは?


▼はる さん:
>ウッシさん
>
>おはようございます。
>返信ありがとうございます。
>
>.Formula = "=IF(B7<>0,B7,"""")">
>を
>.Formula = "=IF(E7<>0,E7,"""")"
>に変更したら左側は巧く動作してくれました。
>
>しかし右側は同じようにA君だけ一番下に移動してしまいます。。。
>
>
>ウッシさんから助言頂いたことも確認しました。
>・Selectで右側が選択されていました。
>・ユーザーリストの編集ではきちんと「$H$7:$J$16」が選ばれており,更にリストの中にもA君は含まれていました。
>
>少し不思議なことが分かったので記載しておきます。
>右のリストを手動で選択し,並べ替えを行ってもA君だけ違うところにいました。
>(降順,昇順ではきちんと並びました)

【73018】Re:データ数が変動するときの並び替えの...
お礼  はる  - 12/10/23(火) 10:47 -

引用なし
パスワード
   ウッシさん

返信ありがとうございます。
原因が分かりました!
私の初歩的なミスで左側のエリアでは「Aくん」となっており,
右側のエリアでは「A君」となっていました。。。
こんな単純なミスで何度もお手を煩わせてしまい,申し訳ございませんでした。

これで解決しました。
色々とありがとうございました。

こんな初心者なので分からないことが沢山あり,また質問させて頂くこともあるかと思いますが,今後ともよろしくお願いします。

【73019】Re:データ数が変動するときの並び替えの...
回答  ウッシ  - 12/10/23(火) 11:27 -

引用なし
パスワード
   こんにちは

どんな現象か分かると原因も推察出来ますよね。

別件なのですが、ユーザー設定リストに設定出来る項目の数は確定された数字はなくて
メモリ等に依存するらしいので、もしA列のデータが格納出来ない場合は下記のコードに変更して下さい。

処理に時間が掛かる場合は UO3さんの Dictionary のコードの方をお使い下さい。

Sub test6()
  Dim s As Range
  Dim t As Range
  Dim sh As Worksheet
  Const c As Long = 7
  Dim x As Long
  Set sh = Worksheets("Sheet1")
  Set s = sh.Range("A7", sh.Cells(Rows.Count, "A").End(xlUp))
  Set t = s.Resize(, c)
  With t.Columns(c)
    .Formula = "=IF(E7<>0,E7,"""")"
    .Value = .Value
    
    Call test_sort(t, "G1", xlNo, xlDescending)
    
    On Error Resume Next
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeConstants).EntireRow), "A1", xlNo, xlAscending)
    Call test_sort(Intersect(t, .SpecialCells( _
            xlCellTypeBlanks).EntireRow), "A1", xlNo, xlAscending)
    On Error GoTo 0
    .ClearContents
      
    .Formula = "=MATCH(H7,A:A,0)"
    .Value = .Value
      
    Call test_sort(s.Offset(, c - 1).Resize(, 6), "A1", xlNo, xlAscending)
    .ClearContents
    
  End With
    
End Sub

【73020】Re:データ数が変動するときの並び替えの...
お礼  はる  - 12/10/23(火) 11:46 -

引用なし
パスワード
   ウッシさん

追加コメントありがとうございます。
詳しく理解できていないのですが,ウッシさんのコードはユーザー設定リストに設定していて,UO3さんのコードは Dictionaryを使っているということなんですね。
ん〜,むずかしい。。。

お二人に作って頂いたコードをじっくり解読して勉強してみます。

本当にありがとうございました。

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