こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルの重複データの抽出(条件付)

エクセルの以下のようなデータから3時間以上連続で出現しているデータを抽出してその行に色をつけるようなマクロを組みたいのですがそのような方法はないでしょうか。

A列   B列
6/1 3:00 AAA社
6/1 3:00 BBB社
6/1 3:00 CCC社
6/1 2:00 AAA社
6/1 2:00 CCC社
6/1 2:00 DDD社
6/1 1:00 AAA社
6/1 1:00 DDD社
6/1 1:00 EEE社
6/1 1:00 FFF社
6/1 1:00 GGG社
6/1 0:00 AAA社
6/1 0:00 BBB社
6/1 0:00 CCC社
6/1 0:00 DDD社
6/1 0:00 GGG社
6/1 0:00 HHH社




A列は日時、B列は企業名です。
B列の企業名が3時間以上連続して出現している行を抽出して、その行(または企業名)に色をつけるか、または重複してる企業名の一覧表示をしたいです。
この例の場合、AAA社とDDD社になります。
(CCC社は3回出現してるけど、3時間連続していないので対象外。)
3時間以上連続して出現というのがポイントです。
データは2000行ほどで、24時間分です。
マクロ初心者でいろいろ検索してみたのですが、わからずすごく困っています。よろしくお願いします。

投稿日時 - 2008-06-06 13:26:13

QNo.4079564

すぐに回答ほしいです

質問者が選んだベストアンサー

VBAではありませんが、もし
A列   B列
2008/6/1 0:00AAA社
2008/6/1 0:00BBB社
2008/6/1 0:00CCC社
2008/6/1 0:00DDD社
2008/6/1 0:00GGG社
2008/6/1 0:00HHH社
2008/6/1 1:00AAA社
2008/6/1 1:00DDD社
2008/6/1 1:00EEE社
2008/6/1 1:00FFF社
2008/6/1 1:00GGG社
2008/6/1 2:00AAA社
2008/6/1 2:00CCC社
2008/6/1 2:00DDD社
2008/6/1 3:00AAA社
2008/6/1 3:00BBB社
2008/6/1 3:00CCC社
のように日時を昇順に並び替えてよいのでしたら、C列に
=COUNTIF(B2:INDEX(A:B,MATCH(A2+2/24,A:A),2),B2)
入れて下フィル 3時間以内に何度同じ会社名がでるか表示します。
3が出たものが対象です。
これでよければ、条件付書式に応用してみてください。

投稿日時 - 2008-06-06 14:21:50

お礼

早い回答ありがとうございました。
エクセルの関数で3時間連続の判定ができるんですね。大変参考になりました。
マクロでC列に入れれば自動で判定できそうですね。
ありがとうございます!!

投稿日時 - 2008-06-09 10:45:44

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

小難しい方法しか思いつきませんでした。久しぶりにクラスを使用して、随分時間がかかってしまいました。こんなのを理解しようとするよりは、並び替えて自分の目で確認した方がずっと早い...
A,B列の先頭からデータが入っている事を前提にしています。セルの着色+該当する社名をD列に表示します。A No.1の方がGoodですよね。ご参考まで。
<標準モジュール>
Sub test()
Dim myDic As Object, myKey As Variant
Dim rng As Range
Dim targetRange As Range
Dim myCells() As myCellClass
Dim clsCounter As Long
Dim i As Long, j As Long

Set targetRange = ActiveSheet.Range("a1").CurrentRegion.Columns(1)
Set myDic = CreateObject("Scripting.Dictionary")
ReDim myCell(0 To 0)
For i = 1 To targetRange.Cells.Count
Set rng = targetRange.Cells(i)
If Not myDic.exists(rng.Offset(0, 1).Value) Then
clsCounter = UBound(myCell) + 1
ReDim Preserve myCells(0 To clsCounter)
Set myCells(clsCounter) = New myCellClass
myCells(clsCounter).add rng
myDic.add rng.Offset(0, 1).Value, myCells(clsCounter)
Else
myDic.Item(rng.Offset(0, 1).Value).add rng
End If
Next i
'
myKey = myDic.keys
j = 0
For i = 0 To myDic.Count - 1
If myDic.Item(myKey(i)).flag = True Then
ActiveSheet.Range("D1").Offset(j, 0).Value = myKey(i)
j = j + 1
End If
Next i
Set myDic = Nothing
End Sub

<クラスモジュール> クラス名:myCellClass
Private myGroup() As Range
Private groupCounter As Long
Private lastRange As Range
Private myFlag As Boolean

Private Sub Class_Initialize()
groupCounter = 1
ReDim myGroup(1 To 1)
End Sub

Public Sub add(newRange As Range)
If myGroup(groupCounter) Is Nothing Then
Set myGroup(groupCounter) = newRange
Else
If DateDiff("h", newRange.Value, lastRange.Value) = 1 Then
Set myGroup(groupCounter) = Union(myGroup(groupCounter), newRange)
If myGroup(groupCounter).Cells.Count >= 3 Then
myGroup(groupCounter).Interior.ColorIndex = 6
myGroup(groupCounter).Offset(0, 1).Interior.ColorIndex = 6
myFlag = True
End If
Else
groupCounter = UBound(myGroup) + 1
ReDim Preserve myGroup(1 To groupCounter)
Set myGroup(groupCounter) = newRange
End If
End If
Set lastRange = newRange
End Sub

Public Function flag() As Boolean
flag = myFlag
End Function

投稿日時 - 2008-06-07 01:37:44

お礼

ありがとうございます。
マクロ(VBA?)超初心者なのでこのプログラムを理解するのは難しそうですが、いつかこんなプログラムをささっと書けるようになれたらすごくかっこいいですね!!少しずつでも、理解して使えるようになっていきたいです。
みなさん、すごいですね。
ありがとうございました。

投稿日時 - 2008-06-09 10:50:01

あなたにオススメの質問