横に並んだデータから３つの連続セルを探して並び替えをしたい

質問

ID番号　　　　　日付
１２２２　　　２００４０５０１、２００４０５３１、２００４０６０１、２００４０８０１、２００４０８０２、２００４０８０３、２００４１１２３、・・・

というデータが並んでいます。この横にならんだデータから3日連続したデータを取り出して、残りを並び替えたいのですが良い方法がありますでしょうか？

上記の場合、２００４０８０１、２００４０８０２、２００４０８０３のデータだけ抜き出したいのです。

しかもこの3つの連続データは、IDごとに異なる日付のデータです。

最初は手で、3つの連続したデータを別シートにコピペしたのですが、量が膨大すぎておいつきません。IDは全部で７００件くらいあります。オートフィルタを使おうにも結局、コピペと同じ手間になることに気づいて困っています。

何か良い方法があれば教えて頂けるととっても助かります。

回答No.5

rio_d · ベストアンサー

こんばんは。No.2です。

マクロの勉強中という事なので、図に乗ってwマクロ作ります。
一応No.2のマクロ版ということで。勉強の足しになればいいなと思います。
No.3さんの「日付が順に並んでいない場合」とNo.4さんの「日付のフォーマットがいろいろ」の場合について作るのはごめんなさい。体力ありません。

実際は元データがもっと複雑だと思うので(セルのデータ型、空白セル、はじかれたデータの扱い、データのソートなど)、改善点がえらくありますが。
あと、これコピペすると失敗します。半角スペースだとうまく表示できないので全角スペース使いまくりです。ついでに対応がわかりやすいように矢印つけてます(大きなお世話ですが)。

'---------------------------------------
Sub マクロ()

Dim iRow As Integer　　' ←調査セルの縦位置です
Dim iCol As Integer　　' ←調査セルの横位置です
iRow=2　　' 最初のセルを決めます
iCol=2

Do Until Cells(iRow,1)=""　　　　　　' iRow行のIDが無くなるまでループ
↑　Do Until Cells(iRow,iCol+2)=""　 ' (iRow,iCol)の二つ隣が無くなるまでループ
↑　↑　If (Cells(iRow,iCol)=Cells(iRow,iCol+1)+1) And _
↑　↑　　 (Cells(iRow,iCol+1)=Cells(iRow,iCol+2)+1) Then ' ３連続データの判断
↑　↑　↑
↑　↑　↑　　　Cells(iRow,10)=Cells(iRow,iCol)
↑　↑　↓　　　Cells(iRow,11)=Cells(iRow,iCol+1)
↓　↓　↓　　　Cells(iRow,12)=Cells(iRow,iCol+2)
↓　↓　↓
↓　↓　End If
↓　↓　iCol=iCol+1 ' 次の列へ
↓　Loop
↓　iRow=iRow+1 ' 次の行へ
Loop

End Sub
'---------------------------------------
Do-LoopとIf-End Ifのみでザッといけます。理想はNo.4さんなんですがw

ちなみにIfのところは、日付の空白や重複が無ければ
　　If (Cells(iRow,iCol)=Cells(iRow,iCol+2)+2) Then
でもOKです。

で、ご質問の件ですが、マクロは大体変数使います。
上記のものだとiRow,iColを整数型(Integer)で使っています。

お礼

丁寧に本当にありがとうございます。教えて頂いた方法でやってみます。まだマクロがよくわからないので、頑張ってやってみますね。

回答No.4

at121

元のデータシート
A列　　　　B列　　　C列　・・・
ID番号　　 日付
1221 20040501 20040502 20040503 20040801 20040802 20040803 20041123
1222 20040501 20040531 20040601 20040801 20040802 20040803 20041123

出力
1221 2004/5/1 2004/5/2 2004/5/3
1221 2004/8/1 2004/8/2 2004/8/3
1222 2004/8/1 2004/8/2 2004/8/3

課題
・元データの日付は"順番"　古い＜新しい　のこと
・連続3日　以上を重複して出力する　4日の場合2回
　　　5日の場合3回
・日付の形式　20040501　は文字列として処理
　　日付形式なら別途変更　出力は日付として計算ができるように　YYYY/MM/DD　　
・「残りを並び替えたい」は未処理　　別途検討
・出力用のシートSheets("連続3日")　は上書きします。
　　何か処理するなら別の名前で・・

使い方　データのあるシートを選択してマクロ実行

設定　　標準モジュールを追加して貼り付け

Sub シートから連続3日セルを抽出し新規シートに出力()

'出力用のシートを作成・クリア
Set データシート = ActiveSheet
新規シート名 = "連続3日"
On Error Resume Next
Sheets(新規シート名).Cells.Clear
If Err Then
Sheets.Add before:=Sheets(1)
Sheets(1).Name = 新規シート名
End If
On Error GoTo 0

データシート.Select
連続3日データ数 = 0

'
For Each 対象セル In Cells.SpecialCells(xlCellTypeConstants)

If 対象セル Like "########" Then '形式・書式によって工夫
日付 = CDate(Left(対象セル, 4) & "/" & Mid(対象セル, 5, 2) & "/" & Mid(対象セル, 7, 2))
If Trim(対象セル.Offset(0, 1)) = Format(日付 + 1, "YYYYMMDD") And Trim(対象セル.Offset(0, 2)) = Format(日付 + 2, "YYYYMMDD") Then
ID = Cells(対象セル.Row, 1)

'出力シートに　ID　と　3連続　日付データを出力
連続3日データ数 = 連続3日データ数 + 1
With Sheets(新規シート名)
.Cells(連続3日データ数, 1) = ID
.Cells(連続3日データ数, 2) = Format(日付, "YYYY/MM/DD")
.Cells(連続3日データ数, 3) = Format(日付 + 1, "YYYY/MM/DD")
.Cells(連続3日データ数, 4) = Format(日付 + 2, "YYYY/MM/DD")
End With

End If
End If

Next

End Sub

回答No.3

tarame

日付データの順序がばらばらであると考えて
A列が、ID
B～G列(６個)が、日付データとします。
(1)
Ｈ列を空けて
Ｉ列に　=IF(B1="","",IF(C1="",B1,IF(B1<C1,B1,C1)))
Ｊ列に、=IF(C1="","",IF(C1>B1,C1,B1))
と入力し、K～N列までコピーします。
(2)
Ｏ列を空けて
Ｐ列に、=I1
Ｑ列に、=IF(K1="",J1,IF(J1<K1,J1,K1))
Ｒ列に、=IF(K1="","",IF(K1>J1,K1,J1))
と入力し、Q～R列をS～V列にコピーします。
Ｈ～Ｖ列をＷ列から２回分コピーします。
これで、最後の列が日付順になります。

日付データが６個のときで説明しましたが
一般的に、２ｎ個のときは、
(1)と(2)の並べ替えを、ｎ組コピーすることで、
確実に並べ替えることが出来ます。

回答No.2

rio_d

こんばんは。

日付データは、本当に「日付」ですよね?
日付データが文字列や数字の場合は、日付に直してください。←無責任w

(仮定)
　ID番号がA列、日付データがB～H列にあるとします。
　データは2行目から入っているものとします。
　また、日付データは「日付形式」(文字列や数字ではない)であるとします。

まず、隣り合った２つのセルについて、日付が並んでいるかを判断します。

(1) セルI2に「=if(C2-B2=1,1,0)」と入力します。
(2) セルI2の内容を、セルJ2～N2までコピーします。

これで、セルI2にはC2とB2、セルJ2にはD2とC2、…、セルN2にはH2とG2の比較結果が1か0で出ますよね。
つぎは、この比較結果を隣同士で掛け合って、3つ並んでいるかを調べます。

(3) セルO2に、「=i2*j2」と入力します。
(4) セルO2の内容を、セルP2～S2までコピーします。

これで、B2～D2が連続データならO2に、C2～E2が連続データならP2に、…、F2～H2が連続データならS2に「1」が入りますよね。
さて次にいきます。連続データの「最初の日付」を抜き出しましょう。

(5) セルT2に、「=if(o2=1,c2,"")」と入力します。
(6) セルT2の内容を、セルU2～X2までコピーします。

これで、連続データの先頭がT2～X2のいずれかに表示されます。
じゃあ全行にこれを適用し、別シートに貼り付けちゃいましょう。

(7) セルI2～X2の内容を、セルI3～X700くらいまでコピーします。
(8) A列のみを別のシートのA列に貼り付けます。
(9) T列～X列の内容をコピーし、別シートのB列以降に「形式を選択して貼り付け」で「値」のみ貼り付けます。

あと少しです。ここからは別シートのみいじります。

(10) シート全体をB列でソートします。B列に空白のある行が固まりますので、B列の空白を「左側にシフト」で削除してください。
(11) (10)を繰り返し、余分な空白を全部取ってしまいます。
(12) シート全体をA列でソートします。

今、A列にID番号、B列には先頭データが入っていますよね。

(13) C2に「=B2+1」と入力し、D2に「=B2+2」と入力します。
(14) C2～D2の内容を、C3～D700くらいまでコピーします。
(15) C2～D700くらいのデータを選択し、コピーしてから、「形式を選択して貼り付け」で「値」のみを同じ場所に貼り付けます。

完成です。

ちなみにこういう加工は、マクロを使うとめちゃめちゃラクに出来ますよ。

お礼

ありがとうございます。かけ算なんて思いもつきませんでした。これでデータがとりだせそうです。良かったです。マクロは今、勉強中です。本を購入して勉強しているのですがなかなか前にすすみません。この場合のマクロは、変数を使ったマクロになるのでしょうか？また質問してしまってすみません。

回答No.1

osamuy

現状の形式だと、データの加工が面倒なので、

ID番号:順番:日付
1222:1:20040501
1222:2:20040531
1222:3:20040601
1222:4:20040801
1222:5:20040802
(以下略)

――に変形してみるとか。
三日連続するデータの先頭なら、

=IF( AND( C1=C2+1,C2=C3+1 ), "○", "" )

みたいので見つけられます。

# どうやって変形するかは別問題になりますが。

お礼

ありがとうございます。本当に手間がかかるデータなんです～。