画像が添付された投稿の運用変更について

添付ファイルのようにidとnameが格納されたエクセルで、削除idに該当するデータ行を一気に削除した上で行間を詰めたいと考えていますが、どのようにすれば間単に削除できますか?

削除id
4
7
11
12
13
17
※削除idもエクセルデータで格納されています。
※実際にはデータ数が10万件~で削除しなければいけないidが1000程度あります。

ご存知の方、教えていただけますと幸いです。

「エクセルで該当する条件のデータがある行を」の質問画像

質問者からの補足コメント

  • うれしい

    ありがとうございます!
    これで何とかいけそうな気がします。

    ただ、実際のデータはA~AC列までデータが入っており、idがG列にあります。
    また、削除用idはsheet2のC列に入っています。

    どこを変えたらよろしいでしょうか?

    ご教示いただけますと幸いです。

    No.6の回答に寄せられた補足コメントです。 補足日時:2017/03/16 21:07
  • 作業データは、「Sheet1」で、削除idが格納されているのは同じブックの「Sheet2」とします。
    ともに1行目に項目名、2行目からデータが入っています。

    No.5の回答に寄せられた補足コメントです。 補足日時:2017/03/16 21:33

A 回答 (12件中1~10件)

これは、#8様の回答をマクロにしたものです。



'//
Sub ExtractMacro1()
 'フィルターオプションを使った方法
 Dim sh1 As Worksheet
 Dim sh2 As Worksheet
 Dim shNew As Worksheet '新しいシート
 Dim Rng As Range 'データ用
 Dim Rng2 As Range '削除用
 Dim criteADD As String '削除のデータアドレス
 
 Set sh1 = Worksheets("Sheet1")
 Set sh2 = Worksheets("Sheet2")
 
 With sh2
  '削除用ID
  Set Rng2 = .Range("C2", .Cells(Rows.Count, "C").End(xlUp))
  criteADD = Rng2.Address
 End With
 '新規の貼り付け用のシート
 Set shNew = Worksheets.Add(Before:=ActiveSheet)
 'shNew.Name ="更新済み"
 With sh1
  '範囲の設定
  .Activate '
  Set Rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp).Resize(, 29)) 'AC まで
  'クライテリアの作成 (AF2)に置く
  .Range("AF2").FormulaLocal = "=COUNTIF(" & sh2.Name & "!" & criteADD & ",G2)=0"
  
  'フィルターオプションの実行(新しいシートに貼り付け)
  Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
  "AF1:AF2"), CopyToRange:=shNew.Range("A1"), Unique:=False
  .Range("AF1:AF2").ClearContents
 End With
End Sub
    • good
    • 0
この回答へのお礼

バッチリできました!
ありがとうございましたm(_ _)m

お礼日時:2017/03/17 23:28

No2ですが


>実際にはデータ数が膨大で今回このやり方ではかなりの時間が掛かってしまい難しそうです。
ACまでデータがあるなら、ADを作業列として、
AD2=IF(COUNTIF(Sheet2!C:C,G2)=0,"","○")
AD2のセルの右下をダブルクリック(ACにデータなり式なりが入っているなら自動でその下端までコピーされます)
フィルタを使ってAD列を基準に並べ替え
同様にAD列が空白のものを非表示
AD列のセルにカーソルを合わせ、Ctrl+↓(これでAD列の下端のデータ(つまり○の表示された最下部)のセルにカーソルが移動しました)
その行全体を選択(左端の行番号が書かれている部分をクリックしてください)
Shift+Ctrl+↑(これで先ほどの行から1行目まで全て選択されたはずです)
1行目にタイトル行が残っているようならShift+↓でタイトル行は避けてください。
(空白を非表示にしてタイトル行も見えなくなっていると思います。その場合は不要です)
○の表示された行が全て選択された状態になっていると思いますので、右クリックから削除を行ってください。
フィルタをリセットして非表示になっていた行を戻します。
同様にG列を昇順にすることでID順に並びます。(並べなおさなくても表示を戻した時にきちんと並んでいるかも)

文字にすると長いかもしれませんが、大した事はしてないですよ?
    • good
    • 0
この回答へのお礼

ありがとうございます。
できました!
色々とありがとうございましたm(_ _)m

お礼日時:2017/03/17 23:28

以下でどうなりますか



重複の削除が使えることを前提に・・・

確認は、新規ファイルを開いて、以下を標準モジュールに転記して
testData で確認用データを作成後、Samp1 を実行してみます


Samp1 でやっていることは

Sheet2 の C 列から削除する id を入手して Dictionary に覚えます
Sheet1 の UsedRange 範囲から、G 列の内容を vA に入手
この vA は作業用として使いまわしします
vA(1, 1) = "" にした後、
  For i = 2 To UBound(vA)
    If (dic.Exists(vA(i, 1))) Then
2行目から、Dictionary に覚えているか・・・判別していきます
覚えていたら vA(i, 1) = "" とし
覚えていなかったら行番号を vA(i, 1) = i
これを UsedRange 右横外1列を作業用として書出し
この内容で 重複の削除
重複の削除をすると、"" 部分は1行目以外のものは削除されます
作業列を綺麗にして終了

ソコソコ速く終わるかと・・・


Option Explicit

Public Sub Samp1()
  Dim dic As Object
  Dim vA As Variant
  Dim i As Long, j As Long

  Set dic = CreateObject("Scripting.Dictionary")

  With Worksheets("Sheet2")
    With .Range("C1", .Cells(Rows.Count, "C").End(xlUp))
      vA = .Value
      For i = 2 To UBound(vA)
        dic(vA(i, 1)) = Empty
      Next
    End With
  End With

  With Worksheets("Sheet1")
    With .UsedRange
      With .Columns(1)
        vA = .Offset(, Range("G1").Column - .Column).Value
      End With
      vA(1, 1) = ""
      For i = 2 To UBound(vA)
        If (dic.Exists(vA(i, 1))) Then
          vA(i, 1) = ""
        Else
          vA(i, 1) = i
        End If
      Next

      Application.ScreenUpdating = False
      j = .Columns.Count + 1
      With .Resize(, j)
        .Columns(j).Value = vA
        .RemoveDuplicates j, xlNo
        .Columns(j).ClearContents
      End With
      Application.ScreenUpdating = True
    End With
  End With

  Set dic = Nothing
End Sub


' 確認用データ作成

Public Sub testData()
  Dim vA As Variant, vC As Variant, v As Variant
  Dim i As Long, j As Long

  Randomize

  vC = Array( _
      Array("Sheet1", "G", 100000, 1000), _
      Array("Sheet2", "C", 1000, 1000) _
    )

  Application.ScreenUpdating = False
  For Each v In vC
    ReDim vA(1 To v(2), 1 To 2)
    vA(1, 1) = "id"
    vA(1, 2) = "name"
    For i = 2 To v(2)
      vA(i, 1) = Int(v(3) * Rnd()) + 1
      vA(i, 2) = Cells(vA(i, 1), "A").Address(False, False)
    Next
    With Worksheets(v(0))
      .Cells.Delete
      .Cells(1, v(1)).Resize(v(2), 2).Value = vA
      .Cells(1, "AC").Resize(v(2)).Value = vA
    End With

  Next
  Application.ScreenUpdating = True
End Sub
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
マクロの関数や構文の理解に乏しく中々苦労しましたが何とかなりそうです!
ありがとうごじあました。

お礼日時:2017/03/17 23:27

#6の回答者です。



もう少し、詳しく書けばよかったですね。

'//
Sub InOutDataPcrR()
'2017/03/17
 Const N As Long = 30 ''検索フラッグ★★★
 Dim sh1 As Worksheet '元データ
 Dim sh2 As Worksheet '削除リスト
 Dim shN As Worksheet '新しく作成されるシート
 Dim c As Variant
 Dim rw As Variant
 Dim delRng As Range
 Dim idRng As Range
 Dim dataRng As Range

 Set sh1 = Worksheets("Sheet1") 'データリスト
 Set sh2 = Worksheets("Sheet2") '削除リスト
 With sh2 'シート2
  '削除用のリスト --削除用idはsheet2のC列(先頭が、C2の場合)★
  Set delRng = .Range("C2", .Cells(Rows.Count, "C").End(xlUp))
 End With
 '新しいシート作成
 Set shN = Worksheets.Add(Before:=ActiveSheet)
 
 On Error Resume Next
 shN.Name = "NewSheet"
 On Error GoTo 0
 With sh1 'シート1
  .Activate
  Application.ScreenUpdating = False
  .Columns(N).Insert
  'データはA~AC列=29列目までデータが入っており、idがG列に ★★
  Set idRng = .Range("G2", .Cells(Rows.Count, "G").End(xlUp))
  For Each c In delRng '削除用のリストから
   On Error Resume Next
   rw = 0
   rw = WorksheetFunction.Match(c.Value, .Columns("G"), 0) '★★★
   On Error GoTo 0
   If rw > 0 Then
    .Cells(rw, N).Value = "!" 'AD列に印
   End If
  Next c
  '-------------
  If .AutoFilterMode = True Then
   .AutoFilterMode = False
  End If
  .Cells(1, N).Value = "Tmp"
  Set dataRng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Resize(, N) 'AC列まで含める
  dataRng.AutoFilter
  .AutoFilter.Range.AutoFilter _
  Field:=N, _
  Criteria1:="=" 'BlankCell
  .AutoFilter.Range.Resize(, N - 1).Copy shN.Range("A1")
  .AutoFilterMode = False
  dataRng.Columns(N).Delete
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
 End With
 shN.Activate
End Sub
'//

なお、#7さんも、#8さんも、マクロにすれば、もっとものすごく、コンパクトにできるはずです。特に、#8さんのは、驚くほど簡単なマクロです。次の掲示にすることにしました。
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
フィルタの動作をマクロにするということなんですね。
色々ありがとうございますm(_ _)m
かなり作業が捗るようになりました!

お礼日時:2017/03/17 23:24

一気でなくても簡単なら良いのですよね?であれば、フィルターオプションで削除対象だけ表示して、可視セルのみ削除で行けると思います。


フィルターオプションは、「データ」タブの「並べ替えとフィルター」の「詳細設定」で実行できます。
    • good
    • 0
この回答へのお礼

ご回答ありがとうございました。
実際にはデータ数が膨大で今回このやり方ではかなりの時間が掛かってしまい難しそうです。
他で良い方法を模索してみます!

お礼日時:2017/03/16 21:44

10万件もあるものを数式で対応するのは無理があります。

試すこと
すら止めておいた方がいいです。 Accessに移行するか データベー
スクエリでやるべきだと思います。

元データが A:B列。削除IDリストがD列にあるものとします。

A:B列を「T_元データ」と名前定義
D列を「T_削除ID」と名前定義

[データ]→[その他のデータ ソース]→[Microsoft Query]
→[Excel Files]を選択して[OK]
→ファイルを指定して[OK]
「元データ」を選択し [>]をクリックして[次へ]
→[次へ]→[次へ]→[完了]

[既存のワーク シート]で F1を選択して[OK]

作成されたテーブルを選択した状態で [データ]→[すべて更新]
→[接続のプロパティ]
「定義」タブの[コマンド文字列]に下記のように入力

SELECT id, name
FROM
(SELECT id, name FROM [T_元データ] WHERE id Is Not Null) As a
LEFT JOIN
(SELECT 削除id FROM [T_削除ID] WHERE 削除id Is Not Null) As b
ON a.id = b.削除id
WHERE 削除id Is Null

→[OK]

以上
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
AccessやDBクエリでやるという方法があるのですね。
せっかくご教示いただいたのですが、私には難易度が高そうです…。
時間のある時に勉強してみます!
ありがとうございました。

お礼日時:2017/03/16 21:41

こんにちは。



論理(しくみ)としては、関数と同じなのですが、マクロでなくしてはちょっと考えられませんね。関数式で10万件では負担が大きすぎるような気がしますし、その手順そのものに一定のポリシーがないと、いずれは、必ずミスをすると思うのです。
元データが、A2~入れられているように、
削除データもほぼ同じで、A2~数字または文字が入れられているものとしています。

以下は、なるべく省労力をするように作られています。
10万件ですと、万が一があるので、奇をてらった方法はやめ、正攻法にしました。
至ってシンプルな作りしました。かならず、事前にバックアップ取って行ってください。

'//標準モジュール
Sub InOutDataPcr()
 Dim sh1 As Worksheet '元データ
 Dim sh2 As Worksheet '削除リスト
 Dim shN As Worksheet '新しく作成されるシート
 Dim c As Variant
 Dim rw As Variant
 Dim delRng As Range
 Dim idRng As Range
 Dim dataRng As Range
 
 Set sh1 = Worksheets("Sheet1")
 Set sh2 = Worksheets("Sheet2") '削除リスト
 With sh2
  Set delRng = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
 End With
 Set shN = Worksheets.Add(Before:=ActiveSheet)
 On Error Resume Next
 shN.Name = "NewSheet"  '新しいシート名
 On Error GoTo 0
 With sh1
  .Activate
  Application.ScreenUpdating = False
  .Columns(3).Insert
  Set idRng = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
  For Each c In delRng
   On Error Resume Next
   rw = 0
   rw = WorksheetFunction.Match(c.Value, .Columns(1), 0)
   On Error GoTo 0
   If rw > 0 Then
    .Cells(rw, 3).Value = "!"
   End If
  Next c
  '-------------
  If .AutoFilterMode = True Then
   .AutoFilterMode = False
  End If
  .Cells(1, 3).Value = "Tmp"
  Set dataRng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
  dataRng.AutoFilter
  .AutoFilter.Range.AutoFilter _
  Field:=3, _
  Criteria1:="=" 'BlankCell
  .AutoFilter.Range.Resize(, 2).Copy shN.Range("A1")
  .AutoFilterMode = False
  dataRng.Columns(3).Delete
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
 End With 
 shN.Activate
End Sub
この回答への補足あり
    • good
    • 0
この回答へのお礼

ご回答ありがとうございましたm(_ _)m

お礼日時:2017/03/17 23:31

補足要求です。


1)IDを削除したいシートのシート名は何でしょうか。
2)「※削除idもエクセルデータで格納されています。」・・・とのことですが
この削除IDを格納したエクセルデータは、IDを削除したいシートと別のブックなのですか、
それとも、同じシートなのですか。
別のブックなら、そのブック名と削除IDを格納したシートのシート名を提示してください。
同じブックなら、削除IDを格納したシートのシート名を提示してください。
又、削除IDを格納したシートのどの列に削除IDが格納されていますか?
又、削除IDを格納したシートの1行目は見出し行ですか。それとも、1行名から削除IDが書かれてますか。

マクロを作成する場合、ブック名、シート名、セルの配置に関する正確な情報が判らないと
作成したマクロは、期待した通りに動作しません。その為の補足要求です。
この回答への補足あり
    • good
    • 0
この回答へのお礼

解決しました!
ありがとうございましたm(_ _)m

お礼日時:2017/03/17 23:30

No.3のやり方で良いと思いますが…


ええと、
バージョンによっては、削除するときに行をまとめて選択すると、非表示の行も巻き込むので、
アクティブセルを選択した状態で削除したほうが良いです。

もしも非表示の行まで巻き込んで削除してしまった場合は、
Ctrlキーを押しながらZキーを押して、削除を取り消してフィルタを適用した後に次の操作をしてください。

・Ctrlキーを押しながらGキーを押してジャンプのメニューを出し、「セル選択」
・その後、「アクティブ セル領域」を選択し、「OK」ボタンをクリック。
・そして行削除。


※2013や2016では非表示のセルや行は削除の対象では無かった。
 2007/2010は覚えていませんが、2003以前では巻き込んだはずです。
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
何とか出来ました。
ありがとうございました。

お礼日時:2017/03/16 21:30

C2セルに以下を入れ、下までコピー


(idが格納されたシートをSheet1とした場合の例)
=VLOOKUP(A2,Sheet1!$A$2:$B$20,2,FALSE)

次にフィルタを掛け、C列が#N/A以外のものを表示し、行を一括削除する。
(行番号部分をマウス選択しながら下までドラッグし、右クリックで、行削除)
    • good
    • 2
この回答へのお礼

ご回答ありがとうございます。
削除idをsheet2に格納し、下記をsheet1(作業対象のデータシート)C列コピーで出来ました!
=VLOOKUP(A2,Sheet2!$A$2:$B$21,2,FALSE)
助かります。
ありがとうございました。

お礼日時:2017/03/16 21:29

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!