質問: 【excel】重複を除いた抽出方法 以下のような表があります。 no.項目ランク備考 1aaa01あああ 1aaa02いいい 1aaa02ううう 1aaa03えええ 1aaa04おおお 1aaa05かかか 2bbb01ききき 2bbb02くくく 3ccc01けけけ 項目に対してランクがありますが、ひとつの項目に対しランクは「01」「02」「03」「04」「05」しかあってはならないのに、「02」が重複しているものがあります。(例えば3行目は重複しているものとみなされます。備考は違ってもかまいません)) このような重複を省いてデータを抽出したいのです。 抽出の足がかり的なことでもかまいませんので、宜しくお願いいたします。
回答: 一例です。 '===============標準モジュールに記載============================== sub test2() dim mylastrow as long dim i as long application.screenupdating = false '画面の更新を抑制 if issheetexist("抽出結果") = true then application.displayalerts = false worksheets("抽出結果").delete application.displayalerts = true end if activesheet.copy after:=sheets(sheets.count) sheets(sheets.count).name = "抽出結果" with worksheets("抽出結果") mylastrow = .cells(rows.count, "a").end(xlup).row for i = 2 to mylastrow .cells(i, "e").formula = "=b" & i & "&" & "c" & i next i for i = mylastrow to 2 step -1 if application.countif(.range("e:e"), _ .cells(i, "e").value) > 1 then .rows(i).delete end if next i .columns(5).delete end with application.screenupdating = true end sub function issheetexist(argsheetname as string, optional argworkbook as workbook) as boolean 'シートの存在を確認する関数:存在すればtrueを返す。 dim mywbk as workbook dim mysht as worksheet if argworkbook is nothing then set mywbk = activeworkbook else set mywbk = argworkbook end if issheetexist = false for each mysht in mywbk.worksheets '全シートを順に調べる if mysht.name = argsheetname then '同じ名前が見つかれば終了 issheetexist = true exit for end if next set mywbk = nothing set mysht = nothing end function