[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『連続のデータからないものを簡単にみつけたい』（初心者）
下記のようなデータがあります。 Ａ Ｂ Ｃ 1 1111101 2 1111102 3 1111103 4 1111104 略 1111124 1111201 1111202 略 1111224 Ａ列に７桁のデータがあります 下２桁は01〜24が入ります。24まで行くと 下３桁が繰り上がります。 しかしまれに下2桁がとんでいるところがありそれを探す のに苦労しています。 例えば
Ａ Ｂ Ｃ
1 1111101 2 1111102 3 1111103 4 1111105 5 1111106 の場合1111104が欠落していますが、データ量が10,0000くらい あります。 今はＢ列に01〜24のデータを書き、24セル単位で下へ複写し、Ａ列 の下２桁とにらめっこして確認しています。 欠落するのは連続で２箇所以上ある場合もあります。
Ａ Ｂ Ｃ
1 1111101 2 1111102 3 1111105 4 1111106 5 1111107 この場合1111103と1111104が欠落です。
こんな場合、一つ上のデータと連続になっていないセルへ色を表示させたり 欠落しているデータそのものを一覧表示させることは出来るでしょうか。 もし出来るようならどのようにすればいいかを教えてください。
A2以下の条件付き書式 数式が =RIGHT(A2,2)-RIGHT(A1,2)+(LEFT(A2,5)-LEFT(A1,5))*24>1 とか
（ｍｏｍｏ）
ｍｏｍｏさん。早速のご支援ありがとうございます。 途中の欠落は色がつくようになりました。しかし下２桁２４が欠落している場合 次のxxxxx01に色がつきません。設定方法が悪いのでしょうか（初心者）
オートフィルタを使用して…の場合
B2セルに
=IF(OR(A2-A1={1,77}),IF(OR(A3-A2={1,77}),"OK","↓欠番"),"↑欠番")
を入れて下方向へコピペし
オートフィルタで OK の箇所のチェックを外してエンター…
すると欠番の箇所だけでるのでは…と思ったんですが、
1111924 の次は何処の桁が繰り上がるのかな(^^ゞ
(MJ12)
---- B1=IF($A2=IF(MOD(A1+1,100)=25,A1+77,A1+1),"",IF(MOD(A1+1,100) C1:=IF(B1="","",IF($A2=IF(MOD(B1+1,100)=25,B1+77,B1+1),"",IF(MOD(B1+1,100)=25,B1+77,B1+1))) D1:F1まで右へコピー B1:F1を下へコピー 欠落５個まで(必要なら右へコピーで増やせる) (NB)
ごめん、操作を間違えた様です (Bun)
データはA列に在り、整数値とします もし、文字列の場合、多少コードの変更が必要に成ります
Option Explicit
Public Sub Sample()
Dim i As Long
Dim j As Long
Dim lngRows As Long
Dim rngList As Range
Dim rngResult As Range
Dim vntData() As Variant
Dim vntResult() As Variant
Dim lngTmpF As Long
Dim lngTmpR As Long
Dim strProm As String
'Listの先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = ActiveSheet.Range("A1")
'結果出力の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngResult = ActiveSheet.Range("B1")
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
If lngRows <= 1 And .Value = "" Then
strProm = "データが有りません"
GoTo Wayout
End If
'A列データを配列に取得
vntData = .Resize(lngRows + 1).Value
End With
'結果出力用配列を確保
ReDim vntResult(1 To lngRows, 1 To 1)
'画面更新を停止
Application.ScreenUpdating = False
'先頭データを前半5桁と後半2桁に分割（後半部は計算の都合で1少ない値にシフト）
lngTmpF = (vntData(1, 1) - 1) \ 100
lngTmpR = (vntData(1, 1) - 1) Mod 100
'データ2行目〜最終行まで繰り返し
For i = 2 To lngRows
'本来在るべき数値を計算
lngTmpF = lngTmpF + (lngTmpR + 1) \ 24
lngTmpR = (lngTmpR + 1) Mod 24
'本来在るべき数値と違う場合、BackColorを変更
If vntData(i, 1) <> lngTmpF * 100 + lngTmpR + 1 Then
rngList.Offset(i - 1).Interior.ColorIndex = 36
End If
'本来在るべきデータを配列に格納
Do Until vntData(i, 1) = lngTmpF * 100 + lngTmpR + 1
j = j + 1
vntResult(j, 1) = lngTmpF * 100 + lngTmpR + 1
lngTmpF = lngTmpF + (lngTmpR + 1) \ 24
lngTmpR = (lngTmpR + 1) Mod 24
Loop
Next i
'抜けのデータをB列に出力
If j > 0 Then
rngResult.Resize(j).Value = vntResult
End If
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
MsgBox strProm, vbInformation
End Sub
(Bun)
ん〜そうですか。 私の方では24だけ抜けてもしっかり出来ましたが。 マクロのサンプルを書いている間にBunさんからの投稿がありましたので そちらを参考にされてみてください。 （ｍｏｍｏ）
ｍｏｍｏさん。大変失礼しました。再度やってみましたら、ｍｏｍｏさんの おっしゃる通り色がでました。私のやり方がまずかったです。ごめんなさい。 MJ12さん。ありがとうございます。現れているデータから見て上が無いのか 下がないのかがよくわかります。 Bunさん。ありがとうございます。マクロの中身は正直チンプンカンプンですが ’以降の説明まで入れて頂いて今後の勉強に役立てます。 NBさん。ありがとうございます。欠落しているデータをキーとなるデータの同じ 行へ横に表示され、他の人への説明資料データとして使用できます。 しかし、いつも驚いていますが、ひつのの質問に対して、いろんな角度、考え方という か、早いと か皆さんすごいですね。本当にありがとうございました。明日会社へ行くの が楽しみになりました。 （初心者）
質問者の初心者です。Buｎさんに考えて頂いたマクロですが
Ａ Ｂ Ｃ
1 1111101 2 1111102 3 1111103 4 1111104 略 1111124 1111201 1111202 とあたかも数値が大きくなっていくパターンではなく下２桁と他の数値はまったく 別ものの場合があるとわかりました。 Ａ Ｂ Ｃ 1 1111101 2 1111102 3 1111103 4 1111104 略 1111124 1111201 1111202 1111203 1111203 1111203 1511201 1511202 略 1511224 1311201 1311202 略 1311224
うまく説明できませんが、下２桁の01〜24の連続を確認する必要があり 欠けていデータを確認する必要があります。下２桁01〜24の間は他の151112xx 131112のところは変わりません。下２桁の01〜24の中でないのを探す（作って 頂いたマクロのようにＢ列の上から一覧表させるにはどうすればいいでしょうか
こんなので善いのかな？
Option Explicit
Public Sub Sample_3()
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngRows As Long
Dim rngList As Range
Dim rngResult As Range
Dim vntData() As Variant
Dim vntResult() As Variant
Dim lngTmpF As Long
Dim lngTmpR As Long
Dim strProm As String
'Listの先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = ActiveSheet.Range("A1")
'結果出力の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngResult = ActiveSheet.Range("B1")
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
If lngRows <= 1 And .Value = "" Then
strProm = "データが有りません"
GoTo Wayout
End If
'A列データを配列に取得
vntData = .Resize(lngRows + 1).Value
End With
'結果出力用配列を確保
ReDim vntResult(1 To lngRows, 1 To 1)
'画面更新を停止
Application.ScreenUpdating = False
'先頭データの前半5桁
lngTmpF = (vntData(1, 1)) \ 100
'後ろ2桁の値の初期値
lngTmpR = 0
'データ1行目〜最終行まで繰り返し
i = 1
Do Until i > lngRows
'前5桁が同じなら
If lngTmpF = vntData(i, 1) \ 100 Then
'本来在るべき数値と違う場合、BackColorを変更
If vntData(i, 1) Mod 100 <> lngTmpR + 1 Then
rngList.Offset(i - 1).Interior.ColorIndex = 38
End If
'本来在るべきデータを配列に格納
For j = lngTmpR + 1 To (vntData(i, 1) Mod 100) - 1
k = k + 1
vntResult(k, 1) = lngTmpF * 100 + j
Next j
'後半部の値を更新
lngTmpR = vntData(i, 1) Mod 100
'行位置を更新
i = i + 1
Else
'前値の前半分が完了していない場合
For j = lngTmpR + 1 To 24
k = k + 1
vntResult(k, 1) = lngTmpF * 100 + j
Next j
If lngTmpR < 24 Then
rngList.Offset(i - 1).Interior.ColorIndex = 38
End If
'前半5桁値を更新
lngTmpF = (vntData(i, 1)) \ 100
'後ろ2桁の値の初期値
lngTmpR = 0
End If
Loop
'抜けのデータをB列に出力
If k > 0 Then
rngResult.Resize(j).Value = vntResult
End If
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
MsgBox strProm, vbInformation
End Sub
(Bun)
Bunさん。初心者です。なんどもすみません。今きちっとしたデータがないので 実際のデータが手元になく思い出しながらデータを作って質問をしています。 明日会社へ行ってかきちっと確認させて頂きます。中途半端で申し訳けありません。 そしてありがとうございます。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.