Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9292 / 76737

←次へ　｜　前へ→


	【73008】Re:データ数が変動するときの並び替えの設定

UO3 - 12/10/22(月) 14:18 -


	引用なし

	パスワード

▼はるさん：

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

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

0 hits

▼

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