エクセル：最大値の取得と欠番の一覧表示

質問

お世話になります。
Ａ列に場所名　Ｂ列には棚の番号（または名称）　Ｃ・Ｄ列には数字が入っています。
Ａ・Ｂ・Ｃ列の並びが一つの単位になり、同じ並びのものが複数存在します。
そこで、Ｅ・Ｆ・Ｇ列にＡ・Ｂ・Ｃ列の並びで重複するのもを省いたものを表示したいのです。
さらにＨ列には対応するＤ列の最大値を表示させたい。
Ｂ列は数字だけでなく文字も存在します。

例えば
Ａ　　Ｂ　　Ｃ　 Ｄ
倉庫　12　　1　　1
倉庫　12　　1　　15
倉庫　12　　2　　5
倉庫　12　　2　　21
書庫 　5　　3　　1　　

の場合、１行目のＥ・Ｆ・Ｇ・Ｈ列は　倉庫　12　　1　　15
２行目のＥ・Ｆ・Ｇ・Ｈ列は　倉庫　12　　2　　21
３行目のＥ・Ｆ・Ｇ・Ｈ列は　書庫　5　　 3　　1　となるようにしたい。

以上が最低限やりたいことですが、ピボットテーブルの機能を使いなんとか出来ました。
本当にやりたいことは
Ｉ列に欠番の数を、Ｊ列より右に欠番の一覧を表示させたい。１行目のＩ列は　１と１５→つまり２～１４が欠番となり１３を表示、
２行目のＩ列は５と２１→１～４と６～２０までの１９を表示させる。３行目は１しかないので
０と表示する。
そしてＪ列より右の列に、１行目なら２～１４まで連続して表示。（Ｊ列が２、Ｋ列が３・・・）
２行目ならＪ列が１、Ｋ列が２・・・、Ｎ列が６、Ｏ列が７・・・というように。
３行目は１だけで欠番がないのでなにも表示しない。
ややこしいですがよろしくお願いします。
マクロでも計算式でも構いません。欠番は1000を超えることはないので1000列分くらい計算式を入れておくというものでもＯＫです。

回答No.10

Wendy02 · ベストアンサー

こんばんは。Wendy02です。

>こちらとしては単純に優先順位ＡＢＣＤの順に昇順で並び替えられればＯＫなのですが。

元のご質問の

>倉庫　12　　2　　21
>書庫 　5　　3　　1　　　←こちらが下になって、12 と　5では、5が下になっていたからです。

一番目のSort のOrder1 をxlAscending,　に換え、

.Sort _
　　　　　　　Key1:=.Cells(1, 2), _
　　　　　　　Order1:=xlAscending,

二番目のSort のOrder1 をxlAscending,　に換えれば標準的な並べ替えになるはずです。
.Sort _
　　　　　　　Key1:=.Cells(2, 2), _
　　　　　　　Order1:=xlAscending, _

ただ、元の表が、どのような並び方が良いのかは、本当は分かっていませんので、たぶん、こんな風かなっていうところで、これは、あまり自信がないです。まあ、記録マクロでも可能なものですから、最初は、手作業で試して、記録マクロに写してもよいです。

回答No.9

Wendy02

こんばんは。Wendy02です。

もしかしたら、「お礼」をつけてしまうと、後、入れられない恐れがあるかもしれない不安がありましたので、以下はダミーでもありませんが、当初、作っておいた並べ替えマクロをここにおいておきます。

Sub SortPrc()
'並べ替えマクロ
'基本的に、項目行としての1行目は必要です。
With Range("A1", Range("A65536").End(xlUp)).Resize(, 4) '４列に対して
　　　　 .Sort _
　　　　　　　Key1:=.Cells(1, 2), _
　　　　　　　Order1:=xlDescending, _
　　　　　　　Header:=xlGuess, _
　　　　　　　OrderCustom:=1, _
　　　　　　　MatchCase:=False, _
　　　　　　　Orientation:=xlTopToBottom, _
　　　　　　　SortMethod:=xlPinYin

　　　　　　 .Sort _
　　　　　　　Key1:=.Cells(2, 2), _
　　　　　　　Order1:=xlDescending, _
　　　　　　　Key2:=.Cells(2, 3), _
　　　　　　　Order2:=xlAscending, _
　　　　　　　Key3:=.Cells(2, 4), _
　　　　　　　Order3:=xlAscending, _
　　　　　　　Header:=xlGuess, _
　　　　　　　OrderCustom:=1, _
　　　　　　　MatchCase:=False, _
　　　　　　　Orientation:=xlTopToBottom, _
　　　　　　　SortMethod:=xlPinYin
　　End With
End Sub

補足

丁寧にありがとうございます。この並び替えはどういうルールになっているのでしょうか？こちらとしては単純に優先順位ＡＢＣＤの順に昇順で並び替えられればＯＫなのですが。

回答No.8

Wendy02

こんばんは。

それは良かったでした。ただ、もうしばらく試してみて、こうしたほうがよい、ということがあったら、ここに加えてください。今、こちらから言うのは変ですが、なんとなく、システム的には足りないような気がしています。

その理由の一つとしては、並び替えは、ユーザーに依存しているのが原因だからです。少し、特殊な並べ替えをしているような気がしました。もしも、そちら側で出来ていらっしゃるのでしたら、これは、無視なさって結構です。

なお、今、このご質問は、こちらでマーキングしていますので、こちらに特別な事情がない限りは、しばらく返事が付かなくても、必ず、フィードバックします。

お礼

丁寧にありがとうございます。この質問はあえて締め切らずしばらくこのままにしておきます。

回答No.7

Wendy02

こんばんは。Wendy02です。

>２つで１組とか３つで１組のものがあり同じ並びで重複する場合が少しはあるのです。

私は、それに関しては想定していませんでしたが、並びが昇順になっていなかったら、というのは、頭の片隅にはありました。

>実際の欠番は２と３のため「欠番個数」は２と表示したいです。

それはここだけを直せば、欠番個数は正しくでるはずです。

以下のところから、８行目の部分を直せばよいはずです。

Function BetweenCount(arg2() As Integer) As Integer :1行目
'数値間をカウントする

8行目: If arg2(i) > 0 Then
　　　　　↓
　　　 If arg2(i) > 0 And bufNum <> arg2(i) Then '加入

としてあげれば、直るはずです。

一応、うまくできなかったら、もう一度、こちらですべてをチェックしなおし、コードをすべて出します。

お礼

今日、会社で最終確認しました。私がやりたかった事が完全にできました。本当にありがとうございました。

回答No.6

Wendy02

こんばんは。Wendy02です。

再度、間の数字の生成部分の出力方法を全面的に変更しました。

コードの真ん中の以下の部分をFunction ～　End Function までのひとまとまりの部分を上書きしてください。

分かりにくいようでしたら、Visual Basic Editor の
「(General)　　|　 ここの窓　の▼」　←をクリックして、

　StringOut という名称を選んでくだされば、その場所に飛びます。下のFunction BetweenCount は、残してくださいね。

「数値が文字列として保存」に関しては、そのままでも良いように、日付に変わらないように、罫線素片を利用しました。ですから、オプションのエラーチェックの変更は必要ありません。ただし、文字列と数値が混在になります。

'--------------------------------------------------------
Function StringOut(arg() As Integer) As Variant
　'数字間を文字列出力
　Dim c As Variant
　Dim i As Long
　Dim j As Long
　Dim k As Long
　Dim arBuf() As String
　Dim arBuf2() As Variant
　Dim buf As String
　Dim buf2 As String
　Dim strJoin As String
　ReDim arBuf(UBound(arg()))
　For i = LBound(arg()) To UBound(arg())
　　arBuf(i) = CStr(arg(i))
　Next i
　strJoin = "," & Join(arBuf, ",") & ","

　j = 1
　Do Until j = arg(UBound(arg())) + 1
　　If InStr(strJoin, "," & CStr(j) & ",") = 0 Then
　　　If buf = "" Then
　　　　buf = j
　　　End If
　　End If
　　If InStr(strJoin, "," & CStr(j) & ",") > 0 Then
　　　If buf <> "" Then
　　　　buf2 = j - 1
　　　　ReDim Preserve arBuf2(k)
　　　　If buf <> buf2 Then
　　　　　arBuf2(k) = buf & " ─ " & buf2　'罫線素片を使用
　　　　Else
　　　　　arBuf2(k) = buf
　　　　End If
　　　　k = k + 1
　　　　buf = ""
　　　End If
　　End If
　　j = j + 1
　Loop
　If k = 0 Then
　 'ダミー
　 ReDim arBuf2(0)
　End If
　StringOut = arBuf2()
End Function

'--------------------------------------------------------

なお、今は、画面の出方が遅いので、以下の部分を修正してください。

PickupMax のだいたい、29 行目あたりに、出力用タイトルとありますが、その下に、以下を加えてください。

'出力用タイトル
　Application.ScreenUpdating = False '加入

また、同じマクロの最後の部分で、以下の二行を加えてください。
　Set mRng = Nothing　'加入
　Application.ScreenUpdating = True　'加入
End Sub

なお、うまく行かないようでしたら、こちらで、もう一度、始めからコードを出します。

お礼

こんばんは。会社でいろいろ試してみました。ほとんど問題なく出来ましたが「欠番個数」が-2　になったものがありました。調べてみると忘れていたことがありました。それはＡ～Ｄ列の並びが完全に同じ行が複数ある点です。２つで１組とか３つで１組のものがあり同じ並びで重複する場合が少しはあるのです。欠番個数は最大値からＤ列の数を引いて出してますよね？重複があれば計算が合わなくなります。あらかじめＡ～Ｄ列の並びが完全に同じ行が複数行ある場合１行分だけ残して他の行は削除するのが簡単だと思いますが、行の削除をせずに「欠番個数」がきちんと計算される方法はないでしょうか？

例）
倉庫　12　1　1　1
倉庫　12　1　1　1
倉庫　12　1　1　1
倉庫　12　1　1　4
なら現状では「欠番個数」は０になりますが、実際の欠番は２と３のため「欠番個数」は２と表示したいです。

補足

何度もありがとうございます。今手元にある簡単な例ではエラーもなく完璧に動作しました。明日会社で実際に試してみて再度お礼させていただきます。

回答No.5

Wendy02

こんばんは。Wend02です。

とりあえず、この件だけですが、

>緑の三角印がでます。他の数字では1つだけの欠番の場合4-4とか5-5とかの表示になります。

そのまま出力すると、日付のシリアル値に変わってしまいますので、それは、「'（アポストロフィ)」をつけて、文字列として出しています。

ツール－オプション－エラーチェックの
　文字列として保存されている数値(N)
（　領域内の矛盾した数式(F))←たぶん必要はない

辺りをオフにしてくださいるとありがたいのですが。

書式で、文字列にしてしまうと、また、別の問題が発生することがあります。
それは、数式を用いたときに、Excelでは、そのセルを参照すると、そのセルの数式が不活性になってしまうという不具合があるのです。別に、文字列書式（@)にすることは、やぶさかではないのですが。

それから、
>4-4は単に4と表示されるのが理想です。

今は、1 の場合しか、想定されていませんでした。

今は、こちらで仮定したデータでしか、検査されていませんので、まだ、見えていない部分があります。

回答No.4

Wendy02

こんばんは。Wendy02です。

丁寧に、調べたつもりです。ただ、様々な条件の下では、これがうまくいくか分かりません。なお、ここには、並べ替えプログラムはついていませんので、必ず、並べ替えした状態で行ってください。別途、並べ替えプログラムは、用意はしてあります。

ここを換えれば、位置を替えて書き出すことが可能です。
--------------------------------------------------
　'ユーザー設定
　Const RNG_NAME As String = "E2" '書き出す列の１列目
　Const START_ROW As Integer = 2 'データの始まりの行数
--------------------------------------------------

'標準モジュールに設定してください。
'----------------------------------------------------------------

Private Const MAXCOL As Integer = 256　'現行の最大列は、256列
Sub PickupMax()
'最大値の取得と欠番の一覧表示
　Dim i As Long
　Dim j As Long　'出力行
　Dim k As Integer
　Dim ChkDat As String　'1～3行目までを合わせた文字列
　Dim ColumnChk As Integer　'出力列数
　Dim mRng As Range
　Dim bufNum() As Integer
　Dim Buf1 As Variant

'--------------------------------------------------
　'ユーザー設定
　Const RNG_NAME As String = "E2" '書き出す列の１列目
　Const START_ROW As Integer = 2 'データの始まりの行数
'---------------------------------------------------
　'データ範囲
　Set mRng = Range("A" & CStr(START_ROW), Range("A65536").End(xlUp)).Resize(, 4)

　With mRng
　　　'出力部分を一旦消去
　　　With Range(RNG_NAME).CurrentRegion
　　　　 .Offset(, Range(RNG_NAME).Column - 1).Resize(, .Columns.Count - Range(RNG_NAME).Column + 1).ClearContents
　　　End With

　'出力用タイトル
　If Range(RNG_NAME).Row > 1 Then j = -1
　　 Range(RNG_NAME).Offset(j, 0).Value = "場所"　　'ユーザー設定値
　　 Range(RNG_NAME).Offset(j, 1).Value = "大分類"
　　 Range(RNG_NAME).Offset(j, 2).Value = "中分類"
　　 Range(RNG_NAME).Offset(j, 3).Value = "最大値"
　　 Range(RNG_NAME).Offset(j, 4).Value = "欠番個数"
　　 Range(RNG_NAME).Offset(j, 5).Value = "欠番一覧"
　j = j + 1
　　'チェック用の複数列の文字列データ
　　 ChkDat = .Cells(1, 1).Value & .Cells(1, 2).Value & "," & .Cells(1, 3).Value

　　For i = 1 To .Rows.Count + 1
　　　If ChkDat <> .Cells(i, 1).Value & .Cells(i, 2).Value & "," & .Cells(i, 3).Value Then
　　　　'最大値出力
　　　　.Cells(i - 1, 1).Resize(, 4).Copy Range(RNG_NAME).Offset(j)
　　　　'内訳出力（サブルーチン)
　　　　If k > 0 Then
　　　　　Range(RNG_NAME).Offset(j, 4).Value = BetweenCount(bufNum())
　　　　　Buf1 = StringOut(bufNum())

　　　　　'出力列のチェック
　　　　　If (UBound(Buf1) + 5 + Range(RNG_NAME).Column) > MAXCOL Then
　　　　　　 ColumnChk = MAXCOL - (UBound(Buf1) + 5 + Range(RNG_NAME).Column)
　　　　　Else
　　　　　　 ColumnChk = UBound(Buf1) + 1
　　　　　End If

　　　　　Range(RNG_NAME).Offset(j, 5).Resize(, ColumnChk).Value = Buf1
　　　　　Erase bufNum()
　　　　　k = 0
　　　　　ChkDat = ""
　　　　Else
　　　　　'間がなく次に違うCheck行がある場合
　　　　　ReDim bufNum(0)
　　　　　bufNum(0) = .Cells(i - 1, 4).Value

　　　　　Range(RNG_NAME).Offset(j, 4).Value = BetweenCount(bufNum())
　　　　　Buf1 = StringOut(bufNum())
　　　　　Range(RNG_NAME).Offset(j, 5).Value = Buf1
　　　　　ChkDat = ""
　　　　End If
　　　　j = j + 1
　　　Else
　　　　ReDim Preserve bufNum(k)
　　　　bufNum(k) = .Cells(i, 4).Value
　　　　k = k + 1
　　　End If
　　If ChkDat = "" Then
　　 ChkDat = .Cells(i, 1).Value & .Cells(i, 2).Value & "," & .Cells(i, 3).Value
　　　k = 0
　　　ReDim bufNum(k)
　　　bufNum(k) = .Cells(i, 4).Value
　　　k = k + 1
　　End If
　　Next i
　End With
End Sub
Function StringOut(arg() As Integer) As Variant
　'数字間を文字列出力
　Dim c As Variant
　Dim i As Long
　Dim j As Long
　Dim arBuf() As String
　If UBound(arg()) > 0 Then
　　'番号2 より以上
　　If arg(0) > 2 Then
　　　ReDim Preserve arBuf(j)
　　　 arBuf(j) = "'1 - " & CStr(arg(i - 1) - 1)
　　　 j = j + 1
　　ElseIf arg(0) = 2 Then
　　　ReDim Preserve arBuf(j)
　　　 arBuf(j) = "'1 "
　　　 j = j + 1
　　End If
　　For i = 1 To UBound(arg())
　　　　If arg(i) - arg(i - 1) > 1 Then
　　　　ReDim Preserve arBuf(j)
　　　　　　arBuf(j) = "'" & CStr(arg(i - 1) + 1) & " - " & CStr(arg(i) - 1)
　　　　　　j = j + 1
　　　End If
　　Next i
　Else
　　ReDim arBuf(0)
　　If arg(0) > 2 Then
　　　arBuf(0) = "'1 - " & CStr(arg(0) - 1)
　　ElseIf arg(0) = 2 Then
　　　 arBuf(0) = "'" & CStr(arg(0) - 1)
　　End If
　End If
　StringOut = arBuf()
End Function
Function BetweenCount(arg2() As Integer) As Integer
'数値間をカウントする
　Dim cnt As Integer
　Dim bufNum As Integer
　Dim i As Integer
　If UBound(arg2()) > 0 Then
　　For i = LBound(arg2()) To UBound(arg2())
　　　If arg2(i) > 0 Then
　　　　If arg2(i) <> 1 And bufNum = 0 Then
　　　　　cnt = arg2(i) - 1
　　　　ElseIf bufNum > 0 Then
　　　　　cnt = cnt + (arg2(i) - bufNum) - 1
　　　　End If
　　　　bufNum = arg2(i)
　　　End If
　　Next i
　Else
　　If arg2(i) > 0 Then
　　　cnt = arg2(i) - 1
　　Else
　　　cnt = 0
　　End If
　End If
　BetweenCount = cnt
End Function

'----------------------------------------------------------------

補足

熱心に考えて頂いてありがとうございます。
並び替えはあらかじめしています。
いくつかの例で試してみました。
うまくいかなかった例は次のような場合です。
質問の欄にあげた例で説明します。（１行目にはタイトルとしてA,B,C,Dが入っています）
まず１行目は　場所　大分類　中分類　最大値　欠番個数　欠番一覧　ときちんと表示されます。
２行目にはＡ～Ｄ列の最初のカタマリの場所、大分類、中分類、最大値、欠番個数、欠番一覧も問題なく出来ます。
Ｅ２セルから順に　倉庫,12,1,15,13,2-14　のようにです。
３行目は　倉庫,12,2,21,19　までは表示されますが、Ｊ列より右の欠番一覧が出ません。
ここで止まり以下のエラーメッセージが表示されます。

実行時エラー'9'
インデックスが有効範囲にありません　と出ました。
デバックしてみると　真ん中より少し下　’番号2より以上　という部分から３行下の
arBuf(j) = "'1 - " & CStr(arg(i - 1) - 1)　が黄色くなっています。

いろいろためしてみた結果、セルＤ４の数字が0,1,2の場合は成功します。3以上だとエラーが出ます。
他のＤ列でも同様みたいです。現実には１や２が欠番ということもあります。また０が入力されることはありません。
Ｄ列が２の場合欠番一覧の最初のセル（Ｊ列）には１と表示されますが、数値が文字列として保存されて場合に出る
緑の三角印がでます。他の数字では1つだけの欠番の場合4-4とか5-5とかの表示になります。
わがままついで言いますと4-4は単に4と表示されるのが理想です。
お忙しいと思いますがもう少しお付き合い願えれば幸いです。

回答No.3

Wendy02

こんにちは。Wendy02です。

少し、てこずっています。少し、言い訳させていただきます。

コードを書いているうちに、実務的には、私が、最初考えていたよりも単純ではないような気がしました。やっている内に、私の昔やっていた仕事を思い出したからです。

単なる想像の範囲ならよいのですが……。1000個までとおっしゃいましたが、なんとなく、同じ雰囲気がしたからです。たぶん、ここに出したサンプルの表は、かなり単純化されているのではないでしょうか？

（一応、並べ替えは済んでいるものとしています)

Ａ　　Ｂ　　Ｃ　 Ｄ
倉庫　12　　1　　1
倉庫　12　　1　　15
倉庫　12　　2　　5
倉庫　12　　2　　21
書庫 　5　　3　　1　　

このサンプルの表は、12,1, 1～12,1,15　で、ないものは、確かに、2-14 ですね。

最初は、その歯抜けの数字が、シリーズ（１ずつ増えて、最大値の一つ手前まで抜けはない)になっていると考えていたのですが、私の人生経験(^^;)から、そんなにうまくいかないだろうなって思い、出来上がったものをやり直すことにしました。

私のしていた仕事で、その番号が、お客さんとメーカーの橋渡しのために使われたりしたのです。例えば、国内で流通したものか、海外に輸出されたものか、など、サポート体制が違ってしまいます。

具体的には、以下のようなものを想定しなければ、ダメだなって思ったからです。

Ａ　　Ｂ　　Ｃ　 Ｄ
倉庫　12　　1　　1
倉庫　12　　1　　6
倉庫　12　　1　　10
倉庫　12　　1　　15
倉庫　12　　2　　5
倉庫　12　　2　　15
倉庫　12　　2　　21
書庫 　5　　3　　1

すみませんが、もう少し、お時間をください。

回答No.2

Wendy02

こんにちは。Wendy02です。

お話は分かりました。

>できれば一つのセルに　2-14　とか　1-4　とか6-20　のように表示できればうれしいです。

の方が、VBAでは楽だと思います。VBAで作ってみます。
ただし、ピボットで作った場所自体は、ちょっとデータの吐き出し場所としては、不適当な気がします。
しかし、最初から作ると、こちらでは予想外の問題が発生するような気がします。

コードが長くなると、こちらの思惑で進めることが出来ませんので、いちいち途中で確認してもらわないといけなくなります。

どちらがよいのか、こちらで、しばらく考えてみます。ただし、ピボット自体は、使いません。ピボットはテーブルを残していますので、それが「ある・なし」の判断条件でコードを変えなくてはならないから、面倒な気がします。

特に、この掲示にレスは必要ありません。次にコードを載せてからで良いです。

回答No.1

Wendy02

こんばんは。

設問は読みましたが、以下のようになる、根拠がさっぱり見えてきません。

>１行目のＥ・Ｆ・Ｇ・Ｈ列は　倉庫　12　　1　　15
>２行目のＥ・Ｆ・Ｇ・Ｈ列は　倉庫　12　　2　　21
>３行目のＥ・Ｆ・Ｇ・Ｈ列は　書庫　5　　 3　　1　
>
>となるようにしたい。

と最初の表示とは、一体、どんな結びつきがあるというのでしょうか？
重複を省くというのは、同じものを出さないということであって、同じものがあるもの、すべてを省くということではないと思います。

倉庫　12　　1　　1
倉庫　12　　2　　5

これらは、どんな条件で、これは省かれたのでしょうか？

補足

すみません、言葉が足りませんでした。
第一段階として、Ｅ・Ｆ・Ｇ列にＡ・Ｂ・Ｃ列の並びで重複するものは省いて表示させます。
１行目と２行目のＡ・Ｂ・Ｃ列は　倉庫　12　1　と同じなのでＥ・Ｆ・Ｇ列の１行目は　倉庫　12　1、同じく２行目は　倉庫　12　2　、３行目は書庫　5　3になります。
第二段階としてＨ列の表示です。１行目のＥ・Ｆ・Ｇ列は　倉庫　12　1　であり、
この「倉庫　12　1」の並びと同じものをＡ・Ｂ・Ｃ列からさがし、対応するＤ列の最大値をＨ列に表示させたいのです。1と15なら15が最大値なのでＨ１には15を表示させたいのです。Ｈ２は２１、Ｈ３は１になります。
また質問の後半部分であるＪ列より右の欠番部分の表示ですがエクセルの最大列数が２５６であることを忘れていました。できれば一つのセルに　2-14　とか　1-4　とか6-20　のように表示できればうれしいです。