• 締切済み

ある文字を含む列と同じ行にある列と一致の文字の除外

"名称"(D列)で*ABCD*と含まれるものと同じ行にある"番号"(B列)が一致するものを全て除外したい(D列の値は異なるが、 B列の値が一緒なものを除外したい)。 下記のコードに上記の内容のコードを加えたいのですがやり方を教えていただけないでしょうか? ちなみにVBA初心者なためお手柔らかにお願い致します。 Sub 分別() Dim j As Long j = Cells(Rows.Count, 1).End(xlUp).Row With Range(Cells(3, 1), Cells(j, 43)) .AutoFilter Field:=37, Criteria1:="EFGK" .AutoFilter Field:=4, Criteria1:="*FF0001*", Operator:=xlOr, Criteria2:="*DD0002*" End With End Sub

みんなの回答

  • masnoske
  • ベストアンサー率35% (67/190)
回答No.6

回答側が理解できない点を質問者が理解できないようなら, > "名称"(D列)で*ABCD*と含まれるものと同じ行にある"番号"(B列)が一致するものを全て除外したい(D列の値は異なるが、 B列の値が一緒なものを除外したい)。 の "*ABCD*" と > .AutoFilter Field:=37, Criteria1:="EFGK" .AutoFilter Field:=4, Criteria1:="*FF0001*", Operator:=xlOr, Criteria2:="*DD0002*" の Criteria1,Criteria2の関係が質問文から全く読み取れないのです. D列の "*ABCD*" と "EFGK","*FF0001*", "*DD0002*" の関係が謎です.せめて元データの提示でもあれば,回答者もそれなりに推測できると思いますよ.

  • dell_OK
  • ベストアンサー率13% (740/5646)
回答No.5

まったくもって、回答No.1と回答No.2に同感です。 が、私が勝手に解釈した範囲で、サンプルコードを載せてみます。 フィルタの条件だけではできそうにありません。 なのでD列とB列を走査して、除外したい行を調べて、フィルタ用の列を別に用意する方法です。 フィルタの開始行が3行目のようなので3行目は見出し行、4行目からデータの開始行としています。 フィルタの終了列が43列目のようなので、フィルタ用の列を44行目としています。 Sub SetFilterValue() Const zFilterCol As Long = 44 'フィルタ用列 Const zFirstRow As Long = 4 'データの先頭行 Const zExclusion As String = "1" '除外対象 Const zNotExclusion As String = "0" '除外対象ではない Dim xLastRow As Long 'データの最終行 xLastRow = Cells(Rows.Count, 4).End(xlUp).Row ReDim xBs(0) As String '除外対象となるB列の値 Dim xRow As Long For xRow = zFirstRow To xLastRow If Cells(xRow, 4).Text Like "*ABCD*" Then 'D列の条件 ReDim Preserve xBs(UBound(xBs) + 1) xBs(UBound(xBs)) = Cells(xRow, 2).Text '除外対象となるB列の値をためる End If Next For xRow = zFirstRow To xLastRow If UBound(Filter(xBs, Cells(xRow, 2).Text)) <> -1 Then 'B列の値のいずれかと一致する Cells(xRow, zFilterCol) = zExclusion '除外対象にする Else Cells(xRow, zFilterCol) = zNotExclusion '除外対象にしない End If Next Range(Cells(zFirstRow - 1, 1), Cells(xLastRow, zFilterCol)).AutoFilter zFilterCol, zNotExclusion '除外対象にしないものでフィルタ End Sub

  • masnoske
  • ベストアンサー率35% (67/190)
回答No.3

フィルタを掛けたいようですが,文章から何をしたいのかが読み取れません. とりあえずマクロの記録をして結果を提示して下さい. 初心者はマクロの記録をどんどん使うべきです. コードの書き方やメソッド,プロパティ,オプションの勉強になります.

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

スル―すればよいことなのだろうが、気になって。 質問の意味・趣旨がよく採れない。 B,D列の模擬実例データを10行分程度挙げて、プログラムでどうなるかを離れて、人間が判断するとして、こういう場合だから結果をこういうデータ(状態)にしたい、という書き方をして、質問してはどうか。 初心者がプログラムを例示するより、それは回答者に任せて、質問者は、質問内容の説明に 力を注ぐべきと思う。 自作コードの添削をしてほしいということかもしれないが、やり方だって他に良い方法がある場合も無きにしも非ず。

関連するQ&A

  • エクセル マクロ:文字変更

    教えてください。 sheet5にデータがあります。 マクロを実行すると、一番右の列のセルに○があると●と書き換える 一番右の列のセルに△があると▲と書き換えるコードを作成しています。 下記のコードでは時間がかかってしまいます。 省略 If Sheets("sheet5").Cells(r, cmax).Value = "○" Then Sheets("sheet5").Cells(r, cmax).Value = "●" 省略 AutoFilterを使用してマクロを作成しましたが、列に○と△が両方無いと 範囲指定したセルがすべて▲となってしまいます。 下記コードをどのように手直ししたらよいのか教えて頂けないでしょうか。 よろしくお願いします。 Sub 文字変更() Dim c As Integer Dim cmax As Integer Dim rmax As Long With Sheets("sheet5") rmax = .Range("A3").End(xlDown).Row cmax = .Range("A3").End(xlToRight).Column .Rows("1:1").Select Selection.AutoFilter For c = 2 To cmax Selection.AutoFilter Field:=c, Criteria1:="○" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "●" Selection.AutoFilter Field:=c, Criteria1:="△" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "▲" Selection.AutoFilter Field:=c Next c End With Selection.AutoFilter End Sub

  • 型が一致しません

    いつもお世話になっております。 シートごとに元データの値でフィルタをかけ、 フィルタした各シートのD列の文字列を照らし合わせて整合性を確認したく、 下記のようなVBAをつくりましたが、ここで↓ If name_A <> name_B <> name_C <> name_D Then 型が一致しませんとエラーになります。 どなたかアドバイスをお願いいたします。 Sub 不整合チェック()  'フィルター  Worksheets("Aリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Bリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Cリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3")  Worksheets("Dリスト").Select  If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter  Range("B4").AutoFilter  Selection.AutoFilter field:=1, Criteria1:=Worksheets("元データ").Range("C3") '整合性チェック  Dim name_A As String  Dim name_B As String  Dim name_C As String  Dim name_D As String  name_A = Worksheets("Aリスト").Cells(65536, 4).End(xlUp).Value  name_B = Worksheets("Bリスト").Cells(65536, 4).End(xlUp).Value  name_C = Worksheets("Cリスト").Cells(65536, 4).End(xlUp).Value  name_D = Worksheets("Dリスト").Cells(65536, 4).End(xlUp).Value  If name_A <> name_B <> name_C <> name_D Then   MsgBox "データ不整合を発見しました。 処理を中断します。", vbCritical   Exit Sub  ElseIf mykouiji_kouji = name_nyukin = name_kokyaku = name_uriage Then   MsgBox "問題なし。"  End If End Sub

  • VBAのオートフィルタのタイトル行

    3行目をタイトル行として、3行目以降(で13列にABCという文字列が入っている行)をセレクトすることは可能でしょうか? 以下のようなコードを書くと、1行目にオートフィルタがかかり、1行目もセレクトされてしまいます(13列にABCという文字列が入っている行は正しく選択されています)。 なお、A列はブランク、B1、B2には検索とは無関係の文字列が入っております。 どうぞ宜しくお願いいたします。 Sub 絞り込み() With Worksheets("マスタ0701").Range("B3") .AutoFilter Field:=13, Criteria1:="ABC" .CurrentRegion.Select '.AutoFilter End With End Sub

  • 好みの列にフィルタをかけたいのですが・・?

    Windows XP Home Edition Excel 2002 変数関連の記述の仕方が間違っていると思いますが、 いろいろ試してみましたが、うまく実行できません。 何卒、ご教示お願い致します。 Sub オートフィルタtest() Dim i As Long Dim S As Range Dim Sdown As Range Set S = Selection.Cells(1, i) Set Sdown = Selection.Cells(2, i) Rows("6:6").AutoFilter Sheets(1).Activate Selection.AutoFilter Field:=i, Criteria1:=">=2", Operator:=xlAnd, _ Criteria2:="<3" With Range(Sdown, Sdown.End(xlDown)) .Interior.ColorIndex = 40 End With End Sub

  • Excel VBAについて教えて下さい。

    00というブックとテストというブックがあります。 00のデータを並び替え、一部変更し、テストのシート3へ貼付けを行いたいのですが、 うまく作動してくれません。以下に現在のコードを記載しましたので、ご指摘いただければと思います。 やりたいことは 1.ブック”00”のシート00にて条件がF列が0、E列がHでソートをかけます。 2.E列のHをすべて数字の1に変更します。 3.今度は別の条件、F列が1、E列がH、D列が1でソートをかけます。 4.E列のHをすべて消去します。 5.すべて表示させA列からE列までのデータを、テストのシート3へ貼付けをします。 コピー&ペーストは上手くいくのですが、肝心のソート+文字の変更+消去が出来ていません。 ネットを見ながら書いたコードで、VBAを勉強中です。 よろしくお願いします。 あと、この作業の前にブック00のB列にて昇順のソートをかけるというコードを追加したいのですが、 それについても教えていただけるとうれしいです。 よろしくお願い致します。 Private Sub Worksheet_Activate() Dim wb1 As Workbook Dim wb2 As Workbook Dim i As Long Application.ScreenUpdating = False Set wb1 = ActiveWorkbook Set wb2 = Workbooks.Open("C:\Documents and Settings\デスクトップ\メモ\00.xls", ReadOnly:=True) With wb2.Worksheets("00").Range("A1").CurrentRegion .AutoFilter .AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd .AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd .AutoFilter x = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To x If Cells(i, 5) = "H" Then Cells(i, 5) = Replace(Cells(i, 5), "H", "1") End If Next i With wb2.Worksheets("00").Range("A1").CurrentRegion .AutoFilter .AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd .AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd .AutoFilter Field:=4, Criteria1:="=" & "1", Operator:=xlAnd .AutoFilter x = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To x If Cells(i, 5) = "H" Then Cells(i, 5) = Replace(Cells(i, 5), "H", " ") End If Next i wb2.Sheets("00").Range("B1", .Cells(Rows.Count, 5).End(xlUp)).Copy wb1.Sheets("Sheet3").Range("K3").PasteSpecial wb2.Close False Range("A1").Select Application.ScreenUpdating = True End With End With End Sub

  • エクセルマクロで隣のシートへ値貼付け

    取引先コードを指定すると、 ワークシート1の表でオートフィルターにより該当する取引先を抽出し、 それを隣のワークシート2へ値貼り付けようとしますが、上手くできません。 通常の貼付けでは、計算式などがずれるため、値貼付けにしたいと思っています。 通常の貼り付けはうまくいくのですが、値貼付けをしようとすると、できません。 値貼付けの記述をどう改善すればいいでしょうか。 宜しくお願い致します。 (1)オートフィルターをコピー+通常の貼り付け With Worksheets(1).Cells(3, 20) .AutoFilter Field:=20, Criteria1:=当月取引先 .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets(2).Cells(9, 1) .AutoFilter End With (2)オートフィルターをコピー+値貼り付け With Worksheets(1).Cells(3, 20) .AutoFilter Field:=20, Criteria1:=当月取引先 .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets(2).Cells(9, 1).pastespecial paste:=xlpastevalues .AutoFilter End With

  • エクセルVBA:コピーの貼り付け先

    VBA初心者です。よろしくお願いします。 あるデータベースをセルB2に入力されている値で絞込み、 シート2に貼り付けるとき、下記の(1)がおそらく正解だと思いますが、 ★(質問1) (2)でも同じ結果が得られました。コピー先の目的地を示す「Destination:=」の部分は省略して全く問題なしと考えてよろしいのでしょうか? ★(質問2) (3)で試してみても同じ結果が得られました。range("sheet2!A1") なんて書き方は、たまたま、試してみたらできちゃった(同じ結果が得られた)のですが、使い方として問題ありませんか? ------------------------------------------------------------- (1) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A1") .AutoFilter End With End Sub -------------------------------------------------------------- (2) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Sheets("Sheet2").Range("A1") .AutoFilter End With End Sub -------------------------------------------------------------- (3) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Range("Sheet2!A1") .AutoFilter End With End Sub

  • エクセルVBA:繰り返し処理について

    エクセルVBA初心者です。どうかご指導お願いします。 シート1に入力されたデータベースがあります。 B列には氏名が入力されています。 B2の値で絞りこんで、シート2に貼り付け、 B3の値で絞りこんで、シート3に貼り付け、 B4の値で絞り込んでシート4に貼り付けてB列の値が""(空白)になるまで繰り返すコードの書き方を教えてください。 さらに、B列には、当然同じ氏名が何回も入力されているので、前に一度出た人はパスするというようにしたいのです。 下記コードは、「B2の値で絞りこんで、シート2に貼り付け」だけをしたものですが、このコードを応用して作りたいのです。ご指導お願いします。 Sub test01()  With sheets("sheet1")Range("A1")   .AutoFilter field:=2, Criteria1:=Range("B2")   .CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A1")   .AutoFilter  End With End Sub

  • エクセル2010 VBA 行削除

    特定列が空白であれば行削除をしたいのですが、下記コードでうまく削除は出来るのですが、応答なしになったり、とても遅いのですが、もう少し早く処理出来る方法はありますか? E列が空白であれば行削除をしたいのですが・・ With Range("E13", Cells(Rows.Count, 5).End(xlUp)) .AutoFilter Field:=1, Criteria1:="" On Error Resume Next Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) If Err.Number = 0 Then rng.EntireRow.Delete On Error GoTo 0 .AutoFilter End With

  • <excel:VBA>変数を使って簡略化したい

    google検索してなんとか自力で作ったVBAを下記に貼りました。 きちんと動作はするのですが、せっかくなので変数を使って簡素化し、 データが多くても動作が速くなるようにしたいのです。 いろいろ試しましたが、変数の使い方の知識が乏しく、うまくいきませんでした。 変数としたいのは■マークの2箇所になると思います。 詳しい方、力を貸していただけないでしょうか。 どうぞよろしくお願いいたします。 ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Sub オートフィルタ貼付作業() With Sheets("データ").Range("A3") Application.ScreenUpdating = False Range("AA3:EK3").AutoFilter .AutoFilter Field:=1, Criteria1:="1" ’■Fieldが1ずつ増えていく Range("AA3").Copy Range("Z3") ’■AA3が1列ずつ右へずれていく .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter Range("AA3:EK3").AutoFilter .AutoFilter Field:=2, Criteria1:="1" Range("AB3").Copy Range("Z3") .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter ~~~~~~~~~~~~ 115列分のデータがあり 下記まで同じようにつづきます ~~~~~~~~~~~~ Range("AA3:EK3").AutoFilter .AutoFilter Field:=115, Criteria1:="1" Range("ek3").Copy Range("Z3") .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter End With Application.ScreenUpdating = True Sheets("貼付").Activate Cells.Columns.AutoFit End Sub ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

専門家に質問してみよう