人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルに関して質問があります。
「ある指定範囲において、列Bと列Cの情報が一致する行が複数あるとき、列Eに記載されている日付と時間が最新である行を残し、それ以外の行は削除する。」
こういった、処理を行うにはどうすればよいでしょうか。
ご回答お願いいたします。

●質問者: pa-taitai
●カテゴリ:コンピュータ インターネット
✍キーワード:エクセル
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● an_shoku_panman
●23ポイント

必ず予備のデータを準備の上御使用下さい。

データ作業範囲がA列の4行目からE列の100行目とした場合。

セルに以下の数式を入力し、マクロを標準モジュールに記載を

お願いします。

G1=データ開始列を数値で入力します。Aなら1 Bなら2 Eの場合は5という感じです。

G2=データ最終列を数値で入力します。上記と同じ形式です。

H1=SUMPRODUCT((A4:E100=MIN(A4:E100))*ROW(A4:E100))

H2=J1+1

I1=J1-1

I2=SUMPRODUCT((A4:E100=MAX(A4:E100))*ROW(A4:E100))

J1=ROW(INDEX(G:G,MATCH(10^17,G:G,1)))

他にも作業行・列がある場合お手数ですが変更お願いします。

Sub 一定範囲の消去()

データ開始列 = Range("G1").Value

データ最終列 = Range("G2").Value

データ開始行A = Range("H1").Value

データ開始行B = Range("H2").Value

データ最終行A = Range("I1").Value

データ最終行B = Range("I2").Value

Range(Cells(データ開始行A, データ開始列), Cells(データ最終行A, データ最終列)).Select

Selection.ClearContents

Range(Cells(データ開始行B, データ開始列), Cells(データ最終行B, データ最終列)).Select

Selection.ClearContents

End Sub

削除は問題がでる可能性もあり消去としました。(_ _)


2 ● SALINGER
●23ポイント

こんな感じのマクロではどうでしょうか。

選択した範囲で最新の日付以外の行を削除します。

Sub Macro()
 Dim r As Range
 Dim maxDate As Date
 Dim maxRow As Long
 
 maxRow = 65536
 For Each r In Selection
 If r.Column = 2 Then
 If Cells(r.Row, 2).Value = Cells(r.Row, 3).Value Then
 If maxDate < Cells(r.Row, 5).Value Then
 Rows(maxRow).Delete
 maxRow = r.Row
 maxDate = Cells(r.Row, 5).Value
 Else
 Rows(r.Row).Delete
 End If
 End If
 End If
 Next r
End Sub

3 ● SALINGER
●22ポイント

大変失礼しました。先の回答には間違いがありました。

修正したものを回答します。

注意。選択した範囲の行を削除しますが、複数箇所の選択には対応していません。

Sub Macro()
 Dim firstRow As Long
 Dim lastRow As Long
 Dim i As Long
 Dim maxDate As Date
 Dim maxRow As Long
 
 firstRow = Selection.Row
 lastRow = Selection.Row + Selection.Rows.Count - 1
 
 maxRow = 65536
 For i = lastRow To firstRow Step -1
 If Cells(i, 2).Value = Cells(i, 3).Value Then
 If maxDate < Cells(i, 5).Value Then
 Rows(maxRow).Delete
 maxRow = i
 maxDate = Cells(i, 5).Value
 Else
 Rows(i).Delete
 End If
 End If
 Next i
End Sub

4 ● ardarim
●22ポイント

間違いがあるといけないので、データはバックアップを取ってから試してください。

Option Explicit
Option Base 0

Sub test()

 Dim r1 As Range, r2 As Range
 Dim r1_row As Long
 Dim r1_dataB As Variant, r1_dataC As Variant, r1_dataE As Variant
 Dim rowsToBeRemoved() As Long
 Dim removeRows As Long
 Dim i As Long, j As Long
 Dim r As Long, mr As Long
 
 removeRows = 0
 ReDim rowsToBeRemoved(0)
 
 ' 選択範囲がセルでない場合は終了
 If TypeName(Selection) <> "Range" Then Exit Sub
 
 ' セル全選択されている場合などを考慮し、有効データ範囲のみ対象とする
 mr = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
 
 ' 選択範囲内の行を上から順に走査
 For Each r1 In Selection.Rows
 r1_row = r1.Row
 If r1_row > mr Then Exit For
 r1_dataB = Cells(r1_row, 2).Value
 r1_dataC = Cells(r1_row, 3).Value
 r1_dataE = Cells(r1_row, 5).Value
 ' 重複検査のため選択範囲内の行を上から順に走査
 For Each r2 In Selection.Rows
 If r2.Row > mr Then Exit For
 If r2.Row > r1_row Then
 If Cells(r2.Row, 2).Value = r1_dataB And Cells(r2.Row, 3).Value = r1_dataC Then
 If r1_dataE <= Cells(r2.Row, 5).Value Then
 r = r1_row
 Else
 r = r2.Row
 End If
 ' 既に削除対象になっているか確認し
 For i = 1 To removeRows
 If rowsToBeRemoved(i) = r Then Exit For
 Next i
 If i > removeRows Then
 ' 対象になっていなければ追加(行番号が小さい順)
 removeRows = removeRows + 1
 ReDim Preserve rowsToBeRemoved(removeRows)
 For i = 1 To removeRows - 1
 If rowsToBeRemoved(i) > r Then
 For j = removeRows To i + 1 Step -1
 rowsToBeRemoved(j) = rowsToBeRemoved(j - 1)
 Next j
 rowsToBeRemoved(i) = r
 Exit For
 End If
 Next i
 If i = removeRows Then
 rowsToBeRemoved(removeRows) = r
 End If
 End If
 End If
 End If
 Next r2
 Next r1

 ' 削除対象の行を順に削除
 If removeRows >= 1 Then
 For i = removeRows To 1 Step -1
 Rows(rowsToBeRemoved(i)).Delete
 Next i
 End If

End Sub

やることは単純なんですが、ちゃんとやると面倒くさいですね。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ