excelでのナップザック問題

図のように商品と金額と商品購入の優先順位が指定してあります。

D列以降のように予算上限（２行目）まで購入したい時、優先順位が高い順に〇をつけるにはどのような関数がありますでしょうか。

ここでは、予算ちょうどとしていますが、±１割程度は許容する設定としたいです。
ソルバーは優先順位の設定が難しく断念しました。

よろしくお願いいたします。

TanakaHiroaki

2020/07/31 19:10

Excel関数での「0-1ナップサック問題」でも難易度が高そうです。 https://www.yomogi2017.xyz/entry/2019/01/08/123558 Excel関数での実現する方法は、商品の金額が異なるような実務に適さないと思われます。

pulim

2020/07/31 23:49

回答いただきありがとうございます。ちなみにですが、excel以外であれば可能ということでしょうか。

tosi

2020/08/02 03:17 編集

VBAであれば、B3～B10までの金額を下記nCrの列挙で1～7ケ分繰り返し、 https://teratail.com/questions/281147#reply-400587 全パターンを取り出し、合計金額が1001～999円のパターンに該当する商品に○を付けると出来るかと思います。

sawa

2020/08/03 02:09

細かい部分の定義次第で難易度変わってきそうです。・優先順位　→ 添付の画像だと昇順に並んでいるがランダムなケースも考慮が必要か？・±１割程度 → 例えば予算の1000円ちょうどになった場合、100円商品は買える想定か？それとも買えない方がよいのか？

pulim

2020/08/03 14:00

sawaさん・優先順位について、ランダムなケースも考慮頂けると助かります。・予算について、ちょうどになった場合は、買えないほうがよいです。以上、よろしくお願いいたします。

radames1000

2020/08/03 14:28

Excelのバージョンは何ですか？それによって使用できる関数が変わってきますので。

pulim

2020/08/03 23:43

excelは2016になります

radames1000

2020/08/04 01:15 編集

優先順位と予算ちょうどはどちらが上位ですか？ [例]優先順位1:500円,2:600,3:400,4:100 パターン1（合計1100） 1:500+2:600 パターン2（合計1000） 1:500+3:400+4:100 他にも条件があれば教えてくださいね。あ、添付画像が意図したものであればパターン2の予算ちょうどでしたか。。。

pulim

2020/08/04 06:54

示していただいたパターンですと、パターン１のほうが望ましいです。また、その他条件としては、すべて商品を選定後はまた１から選定するという風にしたいです。ここでは、3日間で7種類がちょうど収まるようにしていますが、最終的には、数千種類かつ100日で作成しようと考えています。詳細に記載していませんでしたが、商品ごとに買い替え時期を設定し、前回購入時から次の購入時期で再度購入するような表を作成したいです。各日の計上の優先順位は以下です。 ①計上数が少ない ②優先順位が高いまた、購入時期は前後3日ずらすことが可能としたいです。とても複雑になってしまい、関数では難しそうですが、検討いただければと思います。

radames1000

2020/08/04 07:01

そこまで膨大な量でしたら、たとえ数式が書けたとしても重すぎて使い物になりません。 VBAでやるのが現実的ですが、完全な開発案件なのでご自身でコツコツコードを書きながら、不明点を質問するような流れになると思います。

tosi

2020/08/06 23:59

「ナップザック問題」面白い課題です。時間が出来たら弄って見たいと思います。

行動規範の内容に同意します

回答4件

優先順位を順不同とし、1000以上の場合はそれ以上加算しない条件としました。
優先順位が上位です。
D3~F10

D3
1=IF(COUNTIF($C3:C3,"〇")>0,"",IF(D$2<=SUMIFS($B$3:$B$10,$C$3:$C$10,"<"&$C3,D$3:D$10,"〇"),"",IF(D$2*1.1>=SUMIFS($B$3:$B$10,$C$3:$C$10,"<"&$C3,D$3:D$10,"〇")+$B3,"〇","")))

投稿2020/08/03 00:27

編集2020/08/04 01:48

radames1000

総合スコア1925

sawa

2020/08/03 02:10

タイトル行とタイトル列には〇は存在しないと思われるので、1つの式にまとめても良さそうですね。

radames1000

2020/08/03 02:30

>sawaさんどの部分ですか？

sawa

2020/08/03 02:46

セル範囲毎に 4つ式を用意されてますが、一番最後のE4の式のCOUNTIF,SUMIFの範囲をタイトル行に食い込ませれば D3に入れた式のコピペで展開できそうです。

radames1000

2020/08/03 02:50

>sawaさん確かにそうですね。ありがとうございます。

radames1000

2020/08/03 03:03

>sawaさんまとめられたと思います。アドバイスありがとうございました。

pulim

2020/08/03 14:03

＞sawaさん　>radames1000さん回答いただき、ありがとうございます。追加でやりたいことも増えたので、手を加えてみようと思います。

sawa

2020/08/04 01:37

合計が1050円の状態で50円商品が買えちゃうんで、 1000ちょうど判定の部分は D$2<=SUMIFS の方が良いかと。

radames1000

2020/08/04 01:43

あ、そうですね。ありがとうございます。抜けがボロボロありそうなので助かります。

行動規範の内容に同意します

【頁No.3】

VBA
1'***********************************************
2' 処理_最優先レコード選択
3'***********************************************
4Function 処理_最優先レコード選択() As Boolean
5    '定義
6    Dim lX As Long
7    Dim blnHitFlag As Boolean
8    Dim strBreak As String
9    Dim strSelect期限Key As String
10    Dim strSelect件数Key As String
11    Dim strSelect優先Key As String
12    
13    blnHitFlag = False
14    '期限Keyの最優先選択
15    If blnHitFlag = False Then
16        lSortX = -1
17        For lX = 0 To UBound(RData)
18            Call SortSet処理(RData(lX).str期限Key)
19        Next
20        Call Sort処理
21        strBreak = ""
22        For lX = UBound(varSortAry) To 0 Step -1
23            If strBreak = "" Then
24                strBreak = varSortAry(lX)
25            Else
26                If strBreak = varSortAry(lX) Then
27                    strSelect期限Key = strBreak
28                    Exit For
29                Else
30                    strSelect期限Key = strBreak
31                    strSelect件数Key = ""
32                    strSelect優先Key = ""
33                    blnHitFlag = True
34                    Exit For
35                End If
36            End If
37        Next
38    End If
39    '件数Keyの最優先選択
40    If blnHitFlag = False Then
41        lSortX = -1
42        For lX = 0 To UBound(RData)
43            If strSelect期限Key = RData(lX).str期限Key Then
44                Call SortSet処理(RData(lX).str件数Key)
45            End If
46        Next
47        Call Sort処理
48        strBreak = ""
49        For lX = 0 To UBound(varSortAry)
50            If strBreak = "" Then
51                strBreak = varSortAry(lX)
52            Else
53                If strBreak = varSortAry(lX) Then
54                    strSelect件数Key = strBreak
55                    Exit For
56                Else
57                    strSelect件数Key = strBreak
58                    strSelect優先Key = ""
59                    blnHitFlag = True
60                    Exit For
61                End If
62            End If
63        Next
64    End If
65    '最優Keyの最優先選択
66    If blnHitFlag = False Then
67        lSortX = -1
68        For lX = 0 To UBound(RData)
69            If strSelect期限Key = RData(lX).str期限Key And _
70               strSelect件数Key = RData(lX).str件数Key Then
71                Call SortSet処理(RData(lX).str優先Key)
72            End If
73        Next
74        Call Sort処理
75        For lX = 0 To UBound(varSortAry)
76            strSelect優先Key = varSortAry(lX)
77            blnHitFlag = True
78            Exit For
79        Next
80    End If
81    '採用パターンのレコード選択
82    If blnHitFlag = True Then
83        mlngDataHitRecord = 0
84        For lX = 0 To UBound(RData)
85            '期限確認
86            If strSelect期限Key = RData(lX).str期限Key Then
87                If strSelect件数Key = "" Then
88                    mlngDataHitRecord = lX
89                    Exit For
90                Else
91                    '件数確認
92                    If strSelect件数Key = RData(lX).str件数Key Then
93                        If strSelect優先Key = "" Then
94                            mlngDataHitRecord = lX
95                            Exit For
96                        Else
97                            '優先確認
98                            If strSelect優先Key = RData(lX).str優先Key Then
99                                mlngDataHitRecord = lX
100                                Exit For
101                            End If
102                        End If
103                    End If
104                End If
105            End If
106        Next
107    End If
108End Function
109
110'***********************************************
111' 処理_結果書込み
112'***********************************************
113Function 処理_結果書込み(ByVal Target As Range) As Boolean
114    Dim lX As Long
115    Dim lRow As Long
116    With RData(mlngDataHitRecord)
117        For lX = 0 To UBound(.Rec明細)
118            lRow = .Rec明細(lX).lngセル行番
119            Cells(lRow, Target.Column) = "○"
120        Next
121        Cells(mlRow2 + 1, Target.Column) = .dbl合計金額
122    End With
123End Function
124
125'***********************************************
126' SortSet処理
127'***********************************************
128Function SortSet処理(ByVal strKeyString As String) As Boolean
129    If lSortX = -1 Then
130        lSortX = 0
131    Else
132        lSortX = UBound(varSortAry) + 1
133    End If
134    ReDim Preserve varSortAry(lSortX)
135    varSortAry(lSortX) = strKeyString
136    SortSet処理 = True
137End Function
138
139'***********************************************
140' Sort処理 (バブルソート)
141'***********************************************
142Function Sort処理() As Boolean
143    Dim lngArryCount As Long
144    lngArryCount = UBound(varSortAry, 1)
145    For lSortX = 0 To lngArryCount Step 1
146        For lSortY = lSortX + 1 To lngArryCount Step 1
147            If varSortAry(lSortX) > varSortAry(lSortY) Then
148                varSortWork = varSortAry(lSortY)
149                varSortAry(lSortY) = varSortAry(lSortX)
150                varSortAry(lSortX) = varSortWork
151            End If
152        Next
153    Next
154    Sort処理 = True
155End Function
156
157'***********************************************
158' Worksheet_Change
159'***********************************************
160Private Sub Worksheet_Change(ByVal Target As Range)
161    Dim lRow1 As Long
162    Dim lRow2 As Long
163    Dim lCol1 As Long
164    Dim lCol2 As Long
165    
166    Call 初期値取得
167    lRow1 = rng予算域.Row
168    lRow2 = lRow1 + rng予算域.Rows.Count - 1
169    lCol1 = rng予算域.Column
170    lCol2 = lCol1 + rng予算域.Columns.Count - 1
171    
172    If lRow1 <= Target.Row And Target.Row <= lRow2 And _
173       lCol1 <= Target.Column And Target.Column <= lCol2 Then
174        lRow1 = rng結果域.Row
175        lRow2 = lRow1 + rng結果域.Rows.Count
176        lCol1 = Target.Column
177        lCol2 = Target.Column
178        Range(Cells(lRow1, lCol1), Cells(lRow2, lCol2)).ClearContents
179        If IsNumeric(Cells(Target.Row, Target.Column)) = True And _
180           Trim(Cells(Target.Row, Target.Column)) <> "" Then
181            Call 処理開始(Cells(Target.Row, Target.Column))
182        End If
183    End If
184End Sub

以上。

投稿2020/08/15 21:45

編集2020/08/21 00:02

tosi

総合スコア553

pulim

2020/08/20 13:00

解決案ありがとうございます。どうにか解読し、活かしたいと思います

行動規範の内容に同意します

ベストアンサー

【頁No.2】

VBA
1'***********************************************
2' 初期値取得
3'***********************************************
4Function 初期値取得() As Boolean
5    '(処理済みSkip)
6    If mblnMaster = True Then Exit Function
7    '(取得WorkRange)
8    Set rng商品域 = Range(str商品域)
9    Set rng予算域 = Range(str予算域)
10    Set rng結果域 = Range(str結果域)
11    '(取得Masterデータ商品)
12    mintArCnt = 0
13    For Each mMyRange In Range(str商品域)
14        ReDim Preserve M商品(mintArCnt)
15        M商品(mintArCnt).strM名称 = Cells(mMyRange.Row, mMyRange.Column + 0)
16        M商品(mintArCnt).dblM金額 = CDec(Cells(mMyRange.Row, mMyRange.Column + 1))
17        M商品(mintArCnt).intM優先 = Cells(mMyRange.Row, mMyRange.Column + 2)
18        M商品(mintArCnt).intM期限 = 0
19        M商品(mintArCnt).lngM行番 = mMyRange.Row
20        M商品(mintArCnt).int計上件数 = 0
21        M商品(mintArCnt).int期限区分 = 0
22        M商品(mintArCnt).int期限日数 = 0
23        M商品(mintArCnt).int順位作成 = 0
24        mintArCnt = mintArCnt + 1
25    Next
26    For Each mMyRange In Range(str期限商品域)
27        For mintArCnt = 0 To UBound(M商品)
28            If M商品(mintArCnt).strM名称 = mMyRange Then
29                M商品(mintArCnt).intM期限 = Cells(mMyRange.Row, mMyRange.Column + 1)
30                Exit For
31            End If
32        Next
33        If M商品(mintArCnt).intM期限 = 0 Then M商品(mintArCnt).intM期限 = 9999
34    Next
35    '(取得Masterデータ予算)
36    mintCount = 0
37    mintArCnt = 0
38    For Each mMyRange In Range(str予算域)
39        ReDim Preserve M予算(mintArCnt)
40        mintCount = mintCount + 1
41        M予算(mintArCnt).int日目値 = mintCount
42        M予算(mintArCnt).lng列位置 = mMyRange.Column
43        mintArCnt = mintArCnt + 1
44    Next
45    '(取得Masterデータ誤差)
46    M誤差.dblMst誤差小 = CDec(Range(str誤差小))
47    M誤差.dblMst誤差大 = CDec(Range(str誤差大))
48    M誤差.dbl合計金額 = 0
49    M誤差.dbl予算金額 = 0
50    M誤差.dbl下限金額 = 0
51    M誤差.dbl上限金額 = 0
52    '(初期値取得完了)
53    mblnMaster = True
54End Function
55
56'***********************************************
57' 処理開始
58'***********************************************
59Function 処理開始(ByVal Target As Range) As Boolean
60
61    Call 初期値取得
62    Call 処理_結果値情報取得(Target)
63    Call 処理_合計金額パターン抽出(Target)
64    If UBound(RData) = 0 Then
65        MsgBox "該当金額なし"
66        Exit Function
67    End If
68    Call 処理_最優先レコード選択
69    Call 処理_結果書込み(Target)
70
71End Function
72
73'***********************************************
74' 処理_結果値情報取得
75'***********************************************
76Function 処理_結果値情報取得(ByVal Target As Range) As Boolean
77    Dim iWork As Integer
78    Dim iCnt As Integer
79    Dim i日目 As Integer
80    Dim i期限日目 As Integer
81    Dim MyStr As String
82    '初期化
83    For mintArCnt = 0 To UBound(M商品)
84        M商品(mintArCnt).int計上件数 = 0
85        M商品(mintArCnt).int期限区分 = 9
86        M商品(mintArCnt).int期限日数 = 0
87        M商品(mintArCnt).int順位作成 = 0
88    Next
89    'Target日目
90    For mintArCnt = 0 To UBound(M予算)
91        If M予算(mintArCnt).lng列位置 = Target.Column Then
92            i日目 = M予算(mintArCnt).int日目値
93            Exit For
94        End If
95    Next
96    '取得処理
97    mlRow1 = rng結果域.Row
98    mlRow2 = mlRow1 + rng結果域.Rows.Count - 1
99    mlCol1 = rng商品域.Column
100    mlCol2 = Target.Column - 1
101    mvarResData = Range(Cells(mlRow1, mlCol1), Cells(mlRow2, mlCol2)).Value
102    For mintArCnt = 1 To UBound(mvarResData)
103        iWork = mintArCnt - 1
104        If mvarResData(mintArCnt, 1) = M商品(iWork).strM名称 Then
105            iCnt = 0
106            i期限日目 = 0
107            For mintCount = UBound(mvarResData, 2) To 4 Step -1
108                If mvarResData(mintArCnt, mintCount) = "○" Then
109                    M商品(iWork).int計上件数 = M商品(iWork).int計上件数 + 1
110                    If i期限日目 = 0 Then
111                        i期限日目 = (M商品(iWork).intM期限 + M予算(mintCount - 4).int日目値)
112                        M商品(iWork).int期限日数 = i期限日目
113                        If i期限日目 <= i日目 Then
114                            M商品(iWork).int期限区分 = 1
115                        End If
116                    End If
117                End If
118            Next
119        End If
120    Next
121    '順位作成
122    lSortX = -1
123    For mintArCnt = 0 To UBound(M商品)
124        MyStr = ""
125        MyStr = MyStr & M商品(mintArCnt).int期限区分
126        MyStr = MyStr & Format(M商品(mintArCnt).int計上件数, "0000")
127        MyStr = MyStr & Format(M商品(mintArCnt).intM優先, "0000")
128        MyStr = MyStr & "(" & mintArCnt & ")"
129        Call SortSet処理(MyStr)
130    Next
131    Call Sort処理
132    For mintArCnt = 0 To UBound(varSortAry)
133        MyStr = varSortAry(mintArCnt)
134        lSortX = InStr(MyStr, "(")
135        lSortY = InStr(MyStr, ")")
136        mintCount = Mid(MyStr, lSortX + 1, lSortY - lSortX - 1)
137        M商品(mintCount).int順位作成 = mintArCnt
138    Next
139End Function
140
141'***********************************************
142' 処理_合計金額パターン抽出
143'***********************************************
144Function 処理_合計金額パターン抽出(ByVal Target As Range) As Boolean
145    Dim lX As Long
146    '初期値セット
147    mlngDataCnt = -1
148    ReDim RData(0)
149    giCountMax = UBound(M商品)
150    giLayerMax = UBound(M商品) + 1
151    M誤差.dbl予算金額 = CDec(Target)
152    M誤差.dbl下限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差小))
153    M誤差.dbl上限金額 = CDec(M誤差.dbl予算金額) + (CDec(M誤差.dbl予算金額) * CDec(M誤差.dblMst誤差大))
154    '自己参照パターン取得
155    For lX = 1 To giLayerMax
156        gintLayer = lX
157        Call 自己参照(1, 0, "")
158    Next
159End Function
160
161' ***********************************************
162' 自己参照
163' ***********************************************
164Private Function 自己参照(iPLayer As Integer, iPNextCount As Integer, strParam As String) As Boolean
165    Dim lX     As Long
166    Dim lY     As Long
167    Dim lZ     As Long
168    Dim MyStr  As String
169    For lX = iPNextCount To giCountMax
170        If iPLayer < gintLayer Then
171            If giCountMax > lX Then
172                Call 自己参照(iPLayer + 1, lX + 1, strParam & "," & lX)
173            End If
174        Else
175            MyStr = strParam & "," & lX:
176            '-----------------------------------
177            'Debug.Print Mid(MyStr, 2) 'デバッグ
178            '-----------------------------------
179            Dim tmp As Variant
180            tmp = Split(Mid(MyStr, 2), ",")
181            mdblKingaku = 0
182            For mintCount = 0 To UBound(tmp)
183                lZ = tmp(mintCount)
184                mdblKingaku = CDec(mdblKingaku) + M商品(lZ).dblM金額
185                If M誤差.dbl上限金額 < mdblKingaku Then Exit For
186            Next
187            If M誤差.dbl下限金額 <= mdblKingaku And mdblKingaku <= M誤差.dbl上限金額 Then
188                Call パターンRecord作成処理(Mid(MyStr, 2), mdblKingaku)
189            End If
190        End If
191    Next
192End Function
193
194'***********************************************
195' パターンRecord作成処理
196'***********************************************
197Function パターンRecord作成処理(ByVal strPattern As String, ByVal dblKingaku As Double) As Boolean
198    '定義
199    Dim lX As Long
200    Dim lY As Long
201    Dim lZ As Long
202    Dim MyStr As String
203    'データRecord作成
204    mlngDataCnt = mlngDataCnt + 1
205    ReDim Preserve RData(mlngDataCnt)
206    RData(mlngDataCnt).strPattern = strPattern
207    RData(mlngDataCnt).str期限Key = ""
208    RData(mlngDataCnt).str件数Key = ""
209    RData(mlngDataCnt).str優先Key = ""
210    RData(mlngDataCnt).dbl合計金額 = CDec(dblKingaku)
211    'データ明細作成
212    Dim tmp As Variant
213    tmp = Split(strPattern, ",")
214    lSortX = -1
215    For lX = 0 To UBound(tmp)
216        lZ = tmp(lX)
217        MyStr = Format(M商品(lZ).int順位作成, "0000") & "-" & Format(lZ, "0000")
218        Call SortSet処理(MyStr)
219    Next
220    Call Sort処理
221    '明細設定
222    lZ = -1
223    With RData(mlngDataCnt)
224        For lX = 0 To UBound(varSortAry)
225            MyStr = varSortAry(lX)
226            lY = Mid(MyStr, InStr(MyStr, "-") + 1)
227            lZ = lZ + 1
228            ReDim Preserve RData(mlngDataCnt).Rec明細(lZ)
229            .Rec明細(lZ).str商品名称 = M商品(lY).strM名称
230            .Rec明細(lZ).int期限区分 = M商品(lY).int期限区分
231            .Rec明細(lZ).int計上件数 = M商品(lY).int計上件数
232            .Rec明細(lZ).int優先順位 = M商品(lY).intM優先
233            .Rec明細(lZ).lngセル行番 = M商品(lY).lngM行番
234            If .Rec明細(lZ).int期限区分 = 1 Then
235                If .str期限Key = "" Then
236                    .str期限Key = 1
237                Else
238                    .str期限Key = CInt(.str期限Key) + 1
239                End If
240            End If
241            .str件数Key = .str件数Key & Format(.Rec明細(lZ).int計上件数, "0000")
242            .str優先Key = .str優先Key & Format(.Rec明細(lZ).int優先順位, "0000")
243        Next
244        If .str期限Key = "" Then .str期限Key = 0
245    End With
246End Function

続きあり

投稿2020/08/15 21:42

編集2020/08/21 00:02

tosi

総合スコア553

【頁No.1】

VBA
1'(Test_Sample_Miniature)
2Option Explicit
3
4'定数領域
5Private Const str商品域 As String = "A3:A10"
6Private Const str金額域 As String = "B3:B10"
7Private Const str優先域 As String = "C3:C10"
8Private Const str期限商品域 As String = "A16:A23"
9Private Const str期限域 As String = "B16:B23"
10Private Const str誤差小 As String = "A13"
11Private Const str誤差大 As String = "B13"
12
13Private Const str予算域 As String = "D2:M2"
14Private Const str結果域 As String = "D3:M10"
15
16'Work領域
17Private mblnMaster As Boolean
18Private mintArCnt As Integer
19Private mintCount As Integer
20Private mMyRange As Range
21Private mlRow1 As Long
22Private mlRow2 As Long
23Private mlCol1 As Long
24Private mlCol2 As Long
25Private mvarResData As Variant
26Private mvarRecord As Variant
27Private mdblKingaku As Double
28
29'WorkData領域
30Private mlngDataCnt As Long
31Private mlngDataHitRecord As Long
32
33'WorkRange領域
34Private rng商品域 As Range
35Private rng予算域 As Range
36Private rng結果域 As Range
37
38'MasterType領域
39Private Type 商品Record
40    strM名称    As String
41    dblM金額    As Double
42    intM優先    As Integer
43    intM期限    As Integer
44    lngM行番    As Long
45    int計上件数 As Integer
46    int期限区分 As Integer  '1=購入期限到達品 9=購入期限未達品
47    int期限日数 As Integer
48    int順位作成 As Integer
49End Type
50Private M商品() As 商品Record
51
52Private Type 予算Record
53    int日目値 As Integer
54    lng列位置 As Long
55End Type
56Private M予算() As 予算Record
57
58Private Type 誤差Record
59    dblMst誤差小 As Double
60    dblMst誤差大 As Double
61    dbl合計金額 As Double
62    dbl予算金額 As Double
63    dbl下限金額 As Double
64    dbl上限金額 As Double
65End Type
66Private M誤差 As 誤差Record
67
68'DataType領域
69Private Type 明細Record
70    str商品名称   As String
71    int期限区分   As Integer
72    int計上件数   As Integer
73    int優先順位   As Integer
74    lngセル行番      As Long
75End Type
76Private Type DataRecord
77    strPattern    As String
78    str期限Key    As String
79    str件数Key    As String
80    str優先Key    As String
81    dbl合計金額   As Double
82    Rec明細()     As 明細Record
83End Type
84Private RData() As DataRecord
85
86'自己参照Work域
87Private gintLayer As Integer
88Private giCountMax As Integer
89Private giLayerMax As Integer
90
91'ソート領域
92Private lSortX As Long
93Private lSortY As Long
94Private varSortAry() As Variant
95Private varSortWork As Variant