規格部品として頭に2桁又は3桁の記号+数字が付いた規格部品があります。(一覧表有り)
例)
PA, PG, QA, SB, BAA等複数<記号の後に続く数字の桁数は不統一です。>
今回作成する個別リスト上のE列に全部品の品番が記載されていますが、規格部品が記載されている行のみを一括削除出来ればと考えています。
そのようなことが可能なのかわかりませんが、マクロの詳しい方がおりましたら是非教えて下さい。
尚、一覧表は別ファイルですが、別シート(SHEET2)に貼り付けてからでも可能です。
宜しくお願いします。
PS: EXCEL2003を利用しています。
No.5ベストアンサー
- 回答日時:
No.2・3です。
No.2の画像通りの配置だとすると
Sheet2の「規格品コード」の数字より前の部分がSheet1のE列と同じ場合、その行を削除すればよい訳ですよね?
コードを↓に変更してみてください。
Sub Sample2()
Dim i As Long, k As Long, lastRow As Long, lastCol As Long
Dim str As String, buf As String, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To Len(wS.Cells(i, "A"))
str = Mid(wS.Cells(i, "A"), k, 1)
If Not str Like "[0-9]" Then
buf = buf & str
Else
Exit For
End If
Next k
.Range("A1").AutoFilter field:=5, Criteria1:=buf & "*"
If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
End If
.AutoFilterMode = False
buf = ""
Next i
End With
Application.ScreenUpdating = True
End Sub
※ 今回もNo2の画像の配置通りとします。
(列は1行目の項目が入っていれば何列あっても構いません)m(_ _)m
この回答への補足
お世話になります。
ご連絡が遅くなり申し訳ありません。
再度トライしたところ、Sheet2に記載の規格部品リストの行間が所々空白になっているところが有り、空白が無いようにして再トライしてみました。
感激です。
完璧に一括削除出来ました。
有難うございました。
お世話になります。
再度回答有難うございます。
大変恐縮ですが、やはり上手くいきませんでした。
リストのデータが全て消えてしまいます。
明日、もう一度トライしてみます。
No.6
- 回答日時:
>削除されず残っている行は末尾に記号付きのもののように思います
再掲:
>シート2のA2以下に、削除したい言葉そのものを記入する
PA
PG
QA
BAA
:
>のように
回答で説明さしあげている通り,たとえば
AH06130MBF
なら,実際に削除したい対象となる文字だけを残して
AH
となってなきゃダメということです。
後ろにまた文字が現れるというのは「元々は無かった条件」なので,当然ダメですね。
やり直し:
sub macro0()
dim i as integer
for i=0 to 9
worksheets("Sheet2").range("A:A").replace what:=i & "*", replacement:="", lookat:=xlpart
next i
end sub
他は先の回答の手順通りなので,間違えないようよく見直しながら実施して下さい。
お世話になります。
お忙しいところ回答有難うございます。
Sheet1の本リスト上では「頭記号+数字+記号」のまま、他部品品番と複数混在していますが、Sheet2の規格部品リストA列上では頭記号のみになっています。
その状態でメインマクロを実行してみましたが、規格部品全てを削除することが出来ませんでした。
※1行目のタイトル行も消えてしまいます。
説明不足でも想定して対応して頂き、大変感謝しています。
有難うございました。
No.4
- 回答日時:
マクロが目的でしょうか?この程度の処理なら下記の手順で可能です。
いつも、マクロを書くよりも速く終わっています。やっていることが見えるのが一番いいです。目的のデータにエラーを発生させ一括処理の対象としてつかめるようにしています。ご参考に。
規格部品の表がH11:H13にあったとして、例えばF列が使えるとして、
1.添付図のような状態でF2セルに
=IF(ISERROR(VLOOKUP(E2,$H$11:$H$13,1,0)),E2,1/0)
と入力し、下にコピーします。規格部品の場合、エラーになります。
2.F列の算式をすべて選択状態のまま、ファンクションキーF5を押します。
3.ジャンプダイアログボックスでセル選択ボタンをクリック。
4.選択オプションダイアログボックスで数式のエラー値のみにチェックしてOK。
5.カレントセルで右クリックして「削除」を選択。
6.削除選択ボックスで「行全体」をオンにしてOK。
7.終わったらF列は始末します。
お世話になります。
回答有難うございます。
私の説明不足なのか、規格部品についてもなぜか?エラーが出ませんでした。
でも、マクロ以外でも遣り方があるのだと勉強になりました。
お手数おかけしました。
No.2
- 回答日時:
こんばんは!
↓の画像のように元データは左側のSheet1にあり、
規格品コードは右側のSheet2のような配列になっているという前提です。
標準モジュールに↓のコードをコピー&ペーストしてマクロを実行してみてください。
Sub Sample1()
Dim i As Long, lastRow As Long, lastCol As Long
Dim c As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
Set c = .Range("E:E").Find(what:=wS.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Range("A1").AutoFilter field:=5, Criteria1:=wS.Cells(i, "A")
Range(.Cells(2, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
End If
.AutoFilterMode = False
Next i
End With
Application.ScreenUpdating = True
End Sub
※ 元データそのものを削除するようにしていますので
別Sheetでマクロを試してみてください。m(_ _)m
お世話になります。
お力をお貸しして頂き有り難く思っていますが、なぜか全て削除されてしまいます。
まだまだ私には力不足で、どう修正するべきかもわかりませんが、回答して頂き感謝しています。
有難うございます。
No.1
- 回答日時:
シート1の1行目にタイトル行
2行目からデータ
E1セルにE列のタイトルとして「何某」と記入されている
準備:
シート2のA1セルにシート1のE1と同じ「何某」と記入する
シート2のA2以下に、削除したい言葉そのものを記入する
PA
PG
QA
BAA
:
のように
【参考】
手を動かして元リストから不要な数字を削除することがどーしてもできない場合:
シート2のA1以下に
何某
PA123456
PG22345
BAA333456
:
のように、元データをとにかく列挙する
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける
sub macro0()
dim i as integer
for i=0 to 9
worksheets("Sheet2").range("A:A").replace what:=i, replacement:="", lookat:=xlpart
next i
end sub
ファイルメニューから終了してエクセルに戻る
ALT+F8を押してマクロを実行する
以上で削除したい正しいリストが準備出来たら
本番:
ALT+F11を押す
標準モジュールを挿入する
下記をコピー貼り付ける
sub macro1()
worksheets("Sheet1").select
range("E:E").advancedfilter _
action:=xlfilterinplace, _
criteriarange:=worksheets("Sheet2").range("A1").currentregion, _
unique:=false
range("E2:E" & range("E65536").end(xlup).row).specialcells(xlcelltypevisible).entirerow.delete shift:=xlshiftup
activesheet.showalldata
end sub
マクロを実行して完成。
お世話になります。
お忙しい中いつも有難うございます。
申し訳ありませんが、規格部品全てが削除されず、いろいろと試しているのですが上手くいきません。
一つだけ質問させて頂いても良いでしょうか?
規格部品の品番ですが、頭に「記号+数字」と記載しましたが、下記のように「記号+数字+記号」となっている部品品番もあります。
例)
AH06130MBF
AH05065M
QP10010P
削除されず残っている行は末尾に記号付きのもののように思いますが、何かマクロの改良が必要なのでしょうか?
ご教示して頂けると助かります。
お手数おかけします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelの複数ファイルの複数行を別ファイル1つのシートにVBA、マクロで集約する方法 5 2022/09/13 06:30
- Excel(エクセル) EXCEL マクロで 同じフォルダ内の複数ファイルの複数行全体を選択して1つのファイルに集約 4 2022/09/27 18:41
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) Changeイベントで複数セルへの貼り付けおよび値削除時に1個目のセルのみエラーになる 3 2022/12/21 09:07
- Excel(エクセル) Excel、同じフォルダ内のExcelファイルの特定シートのみを1つのファイルに集約したい 8 2022/09/07 15:12
- Excel(エクセル) ワードのマクロについて教えてください。 1 2023/03/11 13:50
- Visual Basic(VBA) Excelのマクロコードについて教えてください 1 2022/03/27 12:02
- Excel(エクセル) エクセルで重複データから重複を削除して指定の列に抽出したい 11 2022/05/11 11:26
- Excel(エクセル) Excelで質問です。 詳細(写真) ①黄色の部分を全てプルダウンを設定する。 ②リストはG列 ③リ 1 2023/06/16 21:54
- Excel(エクセル) 製品番号での整列と、検索に関して 3 2023/06/28 19:20
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルでの作業計算方法について
-
Microsoft1Officeの互換ソフト...
-
【マクロ】その時、その時で変...
-
はがきについて。
-
【マクロ】読取専用のファイル...
-
エクセル初心者です 関数の入れ...
-
【関数】適切な文字数の数字を...
-
LOOKUP関数を使えばいいのでし...
-
【関数】先頭だけにある、半角...
-
Excel ピボットテーブルで日付...
-
Excelのpivotについて質問です
-
時間によってファイル名が変わ...
-
エクセル 白黒印刷で白線を印刷...
-
Aというブックの1というシート...
-
エクセル関数を教えてください
-
WPS OFFICEでの縦書きについて
-
Excelのチェックボックスの使い...
-
エクセルの条件付き書式につい...
-
エクセルのセルに同じ大きさの...
-
エクセルの関数について教えて...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel 2019 のピボットテーブル...
-
[関数得意な方]教えて下さい・...
-
Excelにてある膨大なデータを管...
-
[関数について]わかる方教えて...
-
Excel初心者です。 詳しい方、...
-
excelの不要な行の削除ができな...
-
エクセル関数に詳しい方教えて...
-
INDIRECTを使わず excelで複数...
-
[オートフィルタ]で抽出された...
-
エクセルの神よ、ご回答を! エ...
-
エクセル関数に詳しい方、教え...
-
各ページの1番上の表示について
-
Excelで写真のような表を作った...
-
エクセルで不等号記号(≠)が上に...
-
数学 Tan(θ)-1/Cos(θ)について...
-
Excel 2019 は、SPILL機能があ...
-
Excelで全角を半角にしたいので...
-
条件付き書式を教えてください
-
Excel フィルターを掛けた状態...
-
[オートフィルタ]の適用範囲の...
おすすめ情報