[[20050911081408]]　『ユーザー設定リストの共有について』（marokuri）　ページの最後に飛ぶ

『ユーザー設定リストの共有について』（marokuri）

 自宅のパソコンのユーザー設定リストに、オリジナルの並び順を設定して
その順で並び変えを行いオリジナルな並び順にしたいと思います。
複数のパソコンでその並べ替えを頻繁に利用するため自宅ＰＣでマクロの
自動記録で登録しました。（コードの解読はできません)

 あたりまえかもしれませんが、やはり会社のＰＣではうまく結果がでません。
よい方法を教えていただきたいです。
もし会社パソコンのエクセルに同じようにユーザー設定リストを行なった場合は
やはりマクロのコードも変わるかと思うので、マクロで何かよい記述方法があり
ましたら教えて下さい。

 今のところ、自宅と会社の２台でとりあえず使用できればよいです。
マクロを使用するブックはいつも同じで表形式も変わりません。
エクセルバージョン　自宅　2002　　　　　 会社　2000
ＯＳ　　　　　　　　自宅　windowsＸＰ　　会社windows2000

 第一条件・Ｆ列をオリジナルな並び順で並び替え（例・名古屋-岐阜-三重の順)
 第二条件・Ｇ列を降順
 第三条件・Ｃ列を昇順

 ◆自動記録したマクロ◆
Range"A1").CurrentRegion.SortKey1:=Range"F2"),Order1:=xlAscending,Key2:=Range"G2"),Order2:=xlDescending,Key3:=Range"C2"),Order3:=xlAscending,Header:=xlGuess, OrderCustom:=17, MatchCase:=False, Orientation:= xlTopToBottom, SortMethod:=xlPinYin
 ◆------------------◆

 よろしくお願いします。
m(__)m

 その共通で使用したいBookのどこかにそのリストを記入しておいて
そのBookを開く時に取り込んで閉じる時に開放されてはどうでしょうか？
メニューバーのファイルの隣にあるExcelのマークを右クリックしてコードを表示させて
そこに貼り付けます。
この例の場合はSheet1のF列にそのリストが記述されているものとしています。
どうでしょうか？
Option Explicit
Private Sub Workbook_Open()
With Sheets("Sheet1")
    On Error Resume Next
        Application.AddCustomList ListArray:=.Range("F1", .Range("F65536").End(xlUp))
    On Error GoTo 0
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim MyList As Variant
Dim i As Long
With Sheets("Sheet1")
    MyList = .Range("F1", .Range("F65536").End(xlUp)).Value
End With
i = Application.GetCustomListNum(MyList)
If i > 11 Then
    Application.DeleteCustomList i
End If
End Sub
（SoulMan）

 失礼しました。よく読んだら意味が違いますね？(^^;
その基準になるリストは
i = Application.GetCustomListNum(MyList)
で取得出来るので、それを並び替えに使用されたらいいでしょう。
こんな感じでどうでしょうか？
Option Explicit
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2005/9/11  ユーザー名 : SoulMan
'

 '
Dim MyList As Variant
Dim i As Long
With Sheets("Sheet1")
    MyList = .Range("F1", .Range("F65536").End(xlUp)).Value
End With
i = Application.GetCustomListNum(MyList)
If i > 11 Then
Range("A1").CurrentRegion.Sort _
    Key1:=Range("F2"), Order1:=xlAscending, _
    Key2:=Range("G2"), Order2:=xlDescending, _
    Key3:=Range("C2"), Order3:=xlAscending, _
    Header:=xlGuess, OrderCustom:=i, _
    MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
Else
    MsgBox "並び替えの基準になるリストがインポートされていません。"
End If
End Sub
（SoulMan）

SoulMan様

以前にもSoulMan様の的確なアドバイスでピンチを切り抜けられた

ことがありましたので、お名前は忘れられません。

今回もこんな日曜日の朝なのに、教えていただいて感激です。

早速コードを元にやってみたところ、ばっちり、リストを取得

できました。

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

(marokuri)

コメント返信：

[ 一覧(最新更新順) ]

[[20050911081408]] 『ユーザー設定リストの共有について』（marokuri） ページの最後に飛ぶ

[[20050911081408]]　『ユーザー設定リストの共有について』（marokuri）　ページの最後に飛ぶ