下記のVBAコードを実行したら画像の様な結果になります。
グループ2、3のように同じ時間がありますが片方が色がついてしまいます。
グループ2なら両方色つけグループ3も1:06が2つあるのでそちらも色付したのですがどうすればいいでしょうか?
どなたか詳しい方教えてください。
Sub 重複削除()
Dim ws As Worksheet
Dim iLastRow As Long
Dim dict As Object
Dim key As Variant
Dim i As Long
Dim maxRow As Long
Dim maxTime As Date
' Set the worksheet
Set ws = ThisWorkbook.Sheets("時系列") ' 必要に応じてシート名を変更してください
' Get the last row with data in column I
iLastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
' Create a dictionary to store the latest time for each value in column I
Set dict = CreateObject("Scripting.Dictionary")
' Loop through column I to find duplicates and their latest time
For i = 2 To iLastRow ' Assuming there is a header row
If Not IsEmpty(ws.Cells(i, "I").Value) Then
key = ws.Cells(i, "I").Value
If dict.exists(key) Then
' Update the latest time if current time is newer
If ws.Cells(i, "E").Value > ws.Cells(dict(key), "E").Value Then
dict(key) = i
End If
Else
dict.Add key, i
End If
End If
Next i
' Highlight the rows with the latest time for each duplicate value
For Each key In dict.keys
maxRow = dict(key)
ws.Rows(maxRow).Interior.Color = RGB(255, 255, 0) ' Yellow color
Next key
' Clean up
Set dict = Nothing
End Sub
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
補足要求です。
>最終的にやりたいことは色が付いていない行を消しすところまでやりたのですがその作成がうまくいかないのでまず色付けの条件でネットから検索してマクロを作成してうまくいけば色が付いて無い行を消すマクロを追加すればいいかと思い作成中です。
ということは、本当にやりたいことは、色付けをせずに、不要な行(グループ内で最新でない行)を削除したいということでしょうか?
であれば、削除まで一気に行うマクロを1つ作成すれば良いかと思います。
それとも、以下のような2つのマクロを作りたいのでしょうか。
1番目のマクロ:グループ内で最新の行に色付けをするマクロ
2番目のマクロ:色付けされていない行を削除するマクロ
参考までに教えていただきたいのですが、
①データ数(行数)はおよそ何件程度でしょうか。
②グループの数は、何グループありますか。
No.1
- 回答日時:
こんにちは
シートに関しての説明やなさりたいことの説明も曖昧なので、イマイチはっきりとはしませんけれど・・・
(ご提示の図では、E列とI列が隣接しているようなので、セルを結合しているのかどうかもよくわかりませんし・・)
とりあえず以下のように仮定して解釈しました。
・I列にグループ名が記入されている。
・E列に日時がシリアル値で記入されている。
・1行目はタイトル行で処理対象外としてよい。
なさりたいことは
『同じグループ名の行のうち、日付が最も大きい(=最新の)行全てに背景色を付けたい』
と解釈しました。
※ ご提示の日時は「分」までの表示しかありませんけれど、秒数迄を含めて判断してよいものと解釈します。
(見かけ上同じ分数でも、秒数が異なれば異なる時刻と判断する)
>そちらも色付したのですがどうすればいいでしょうか?
ご提示のコードではDictionaryオブジェクトを利用して、グループ名毎の最大日時の行番号を記録する方式になっています。
現状では、
>If ws.Cells(i, "E").Value > ws.Cells(dict(key), "E").Value Then
で、記録したものより大きな時刻が出現した時のみ行番号を入れ替えるようになっていますが、複数存在する可能性を考慮するなら、イコールの場合には記録に追加するようにしておけば宜しいでしょう。
ただし、Dictionaryは key, value形式の記録なので、複数の値を記録するには、value値を工夫する必要があります。
例えば、カンマ区切りの文字列として記録するようにするとか。
あるいは、セル配列を記憶する方法もありそうに思いますが、value値がオブジェクトを許容していたかどうか記憶していませんので、こちらは確認の上ご利用ください。
一方で、ご提示のことをなさりたいのであれば、シートに「条件付き書式」を設定しておけば、いちいちマクロを実行する必要もなく、値が変化すればその内容に応じて背景色が変わるようにできると思います。
エクセルの利用法としては、これが一般的と言えるでしょう。
(Office365であれば、MAXIFS関数が使えるので簡単に設定できます)
また、ご提示のコードでは背景色をクリアしてはいないようなので、値を変更して再度実行するだけでは、必ずしも正しい結果ではない可能性が生じます。
その点でも、条件付き書式であれば、状態に応じて常に判断してくれますので、値を変更すれば即時に結果に反映されます。
方法は全く異なりますが、エクセルに計算してもらう方法を以下ご参考までに。
(処理内容は、最初に示した内容として解釈しています)
(最終列を作業列として利用しています)
Sub Q13853633()
Dim rg As Range, c As Range
Dim maxR As Long
Const f = "=(I2<>"""")*(AGGREGATE(14,6,E$2:E$@/(I$2:I$@=I2),1)=E2)"
With ThisWorkbook.Worksheets("時系列")
maxR = .Cells(Rows.Count, 9).End(xlUp).Row
If maxR < 2 Then Exit Sub
Set rg = .Cells(2, Columns.Count).Resize(maxR - 1)
rg.Formula = Replace(f, "@", maxR)
rg.EntireRow.Interior.Color = xlNone
For Each c In rg
If c.Value Then c.EntireRow.Interior.Color = vbYellow
Next c
rg.ClearContents
End With
End Sub
回答ありがとうございます。
・セルの結合に関してですが画像をわかりやすくするため非表示にしていますので結合はしていません。
・やりたいことはご提示くださった日時は「分」まで判断し秒数が違っても同じにしたい。
・確かにkeyを使うマクロは作成中にネットで検索したときに見て試しましたが使い方が悪くうまくいきませんでした。
またエクセルのご提示ありがとうございます。最終的にやりたいことは色が付いていない行を消しすところまでやりたのですがその作成がうまくいかないのでまず色付けの条件でネットから検索してマクロを作成してうまくいけば色が付いて無い行を消すマクロを追加すればいいかと思い作成中です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) VBAコードが作動しません。修正したいのですが何処に原因かあるか教えて下さい。 1 2024/01/08 16:23
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) ExcelVBAで、index、match関数を使用して、指定範囲に出力したい 3 2022/10/18 21:53
- Visual Basic(VBA) エクセルVBAについて 8 2022/07/13 22:41
- Excel(エクセル) VBA Private Sub Worksheet_Changeで 1 2024/05/01 16:59
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
このQ&Aを見た人はこんなQ&Aも見ています
-
「どうして捨てられないの?」前妻の物を捨てられない男性の心理って?
前妻の物を捨てられない理由に加え、捨てるための手段はあるのかを専門家に聞いてみた!
-
エクセルVBAについて
Visual Basic(VBA)
-
VBAなくなるの?
Visual Basic(VBA)
-
VBA listBoxについて
Visual Basic(VBA)
-
-
4
VBA一覧取得 再投稿
Visual Basic(VBA)
-
5
VBA listBoxから
Visual Basic(VBA)
-
6
VBAで大量のファイルをシート名ごとに転記やらいろいろしたい!
Visual Basic(VBA)
-
7
VBA 複数のエクセルから一つのエクセルに貼り付ける
Visual Basic(VBA)
-
8
時間短縮のために、テキストファイルの入出力をメモリを使って出来ないですか?
Visual Basic(VBA)
-
9
Word VBA MSGBOX 内で降順表示
Visual Basic(VBA)
-
10
VBA 複数条件の分岐処理の上手な方法
Visual Basic(VBA)
-
11
VBA SaveChanges 上書きされない
Visual Basic(VBA)
-
12
Vba SelStart、SelLen教えてください教えてください
Visual Basic(VBA)
-
13
エクセルについて
Visual Basic(VBA)
-
14
VBA指定行削除
Visual Basic(VBA)
-
15
エクセルVBAコードで教えて下さい!
Visual Basic(VBA)
-
16
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
17
Excel マクロについての相談
Visual Basic(VBA)
-
18
VBAで質問があります
Visual Basic(VBA)
-
19
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
20
Excel-VBAのmsgBox()の不思議
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Smartyでインクリメント
-
多次元配列の中で条件に合う要...
-
foreachで上限回数指定方法また...
-
楽天トラベルで「京都の宿」が...
-
多次元配列を、1次元の配列にす...
-
マッチング処理(1:N)
-
CArrayの要素としてCStringArra...
-
String だと「 ByRef引数の型が...
-
foreachの実行結果について
-
C言語の配列をPush(追加)する...
-
PHP 多次元配列変数のデータ受...
-
forとかで連番の変数を一気に格...
-
PHPにてクラスを配列にすること...
-
While文を使って配列の中身を全...
-
PHP SimpleXml unsetについて
-
テキストデータから指定行の削除
-
濁点のソート
-
foreachのなかで次のキーを参照...
-
別ファイルの構造体の値を読み...
-
自動で番号を振りたい
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
重複確認
-
foreachで上限回数指定方法また...
-
マッチング処理(1:N)
-
Excel VBAでフィルター後の対象...
-
VB.NET で 二次元のハッシュは...
-
多次元配列を、1次元の配列にす...
-
SELECT 使用時の bindValue の...
-
Smartyでインクリメント
-
PHPでこのコード自体に意味は無...
-
PHP、{}記号の意味
-
配列を比較して同じものがあっ...
-
phpでforeachの中にforeachがあ...
-
多次元配列の中で条件に合う要...
-
sqlのデーターを『あ行』『か行...
-
ラジオボタンをランダムに表示...
-
キーが倍数の時の値の存在チェ...
-
三重県南部の温泉
-
foreachで配列を、左から縦3列...
-
ジャグ配列
-
構造体の中でユーザー定義型の...
おすすめ情報