• ベストアンサー

型が一致しません

いつもお世話になっております。 シートごとに元データの値でフィルタをかけ、 フィルタした各シートの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

質問者が選んだベストアンサー

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.5

　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 name_A、name_B、name_C、name_Dは文字列のようですが mykouiji_kouji、name_nyukin、name_kokyaku、name_uriageは 数値？、文字列？ 数値の場合の比較にしておきました 文字列なら 　ElseIf mykouiji_kouji & name_nyukin = name_kokyaku & name_uriage Then に変更してね

Turkey-R
質問者

お礼

hige_082さま ご回答ありがとうございます！！ 一発で出来ました～！！！ また、お忙しい中アドバイスを下さいました edomin2004さま、imogasiさま、374649さま にも大変感謝しております。 皆様、本当にありがとうございました！

その他の回答 (4)

  • 374649
  • ベストアンサー率38% (203/527)
回答No.4

自分もあまり詳しくはありませんのではっきりとは解りませんが！ 元データの値（数値）で文字列（文字）との整合性の確認をするというのが理解できません、値が文字列としたらただ単純に文字列が同じということを確認しているのでしょうか。 Dim name_A As String と定義しながら name_A=*******.Value と書いていますがname_AをStringで定義しているのに値はValue（数値）です、これでは全くデータ型が合っていないのでは。 整合性を問うのであれば問われる側と元データのデータ型は同じでなければ、if文などで条件比較をする場合目に見えている文字、数字などでなく コンピュータがどのように処理をするのかを理解するよう自分は心がけています。 条件分岐をする場合も一度に全部やるより一個ずつやって出来たら次を比較する、そのときの値の中身を必ず確認するという風にやってます。 参考になるか判りませんがちょっと思ったので書き込みました。

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

>If name_A <> name_B <> name_C <> name_D Then のような書き方はVBでは出来ないはず。 判定したいことを文章で書いてご覧。 回答が出やすいでしょう。 A,B,C,Dで１つでも違うのがあればということなら、一発で判定するなら、 （A-B)^2+（B-c)^2+（C-D）^2+（D-A)^2 という２乗和の値が０で無い とかを判定するのも１方法か（受験数学を思い出したが）。 勘違いならご免。

noname#77845
noname#77845
回答No.2

＃１です。 elseifの方は、補足の書き方だと全てが一致したときしかTrueになりません。一組でも同じ物がある時にTrueにするなら、AndをOrに変えます。 でも、元の式とは違いますよね？ 質問の式を書き直すなら If name_A <> name_B And name_A <> name_C And name_A <> name_D And name_B <> name_C And name_B <> name_D And name_C <> name_D Then MsgBox "データ不整合を発見しました。　処理を中断します。", vbCritical Exit Sub ElseIf mykouiji_kouji = name_nyukin Or name_kouji = name_kokyaku Or name_kouji = name_uriage Or name_nyukin = name_kokyaku Or name_nyukin = name_uriage Or name_kokyaku = name_uriage Then MsgBox "問題なし。" End If になるはずです。 （というか、本来何がしたかったのかが良く判っていませんが…。）

noname#77845
noname#77845
回答No.1

If name_A <> name_B <> name_C <> name_D Then を力業で、 If name_A <> name_B And name_A <> name_C And name_A <> name_D And name_B <> name_C And name_B <> name_D And name_C <> name_D Then に変更する。これで、全部違うときを判定している。 質問で示された式は、やりたいことは判るけど、あっていません。 条件式が右からか左からかは、忘れちゃいましたが右からだとして、最初に name_C <> name_D が比較されます。比較の結果は「True」か「False」です。次に比較するのは name_B <> True 又は name_B <> False なので、型が一致しません。 （左からの時は、name_Aから考えましょう。）

Turkey-R
質問者

補足

edomin2004さま さっそくのご回答ありがとうございます！ 頂いた通り書き換えたのですが、エラーにはならないですが IF文が素通りされてしまい、比較がされないようです。。。 なにがいけないのでしょうか？？ 　If name_A <> name_B And name_A <> name_C And name_A <> name_D And name_B <> name_C And name_B <> name_D And name_C <> name_D Then 　　MsgBox "データ不整合を発見しました。　処理を中断します。", vbCritical 　　Exit Sub 　ElseIf name_A = name_B And name_A = name_C And name_A = name_D And name_B = name_C And name_B = name_D And name_C = name_D Then 　　MsgBox "問題なし。" 　End If

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • 下記マクロの意味を教えてください。

    Sub 済() With Worksheets("管理表") If .AutoFilterMode Then .AutoFilterMode = False End If Range("O7:P7").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="=*済*", Operator:=xlAnd ActiveWindow.SmallScroll Down:=-12 Range("A1").Select End With End Sub よろしくお願い致します。

  • VBAでコードの編集が上手くいきません

    先日、ご回答頂いたコードを元に自分でいじっているのですが上手く行きません 自分が変更したコード シート1→シート名：変更箇所 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$C$40" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$42" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target.Address <> "$C$44" Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub シート2→シート名：リスト Private Sub worksheet_change(ByVal Target As Excel.Range) Dim i As Long, c As Long Dim h As Range, ha As Range Dim myDic As Object Set ha = Application.Intersect(Target, Range("A:C")) If ha Is Nothing Then Exit Sub Set ha = Application.Intersect(ha.EntireColumn, Range("1:1")) For Each h In ha Set myDic = CreateObject("Scripting.Dictionary") If h.Column = 1 Then c = 3 'A列→C列 If h.Column = 2 Then c = 4 'B列→D列 If h.Column = 3 Then c = 6 'C列→F列 On Error Resume Next For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row If Cells(i, h.Column) <> "" Then myDic.Add Cells(i, h.Column).Value, Cells(i, h.Column).Value End If Next i With Worksheets("変更箇所").Cells(40, c).EntireColumn.Validation .Delete .Add Type:=xlValidateList, Formula1:=Join(myDic.keys, ",") End With Set myDic = Nothing Next End Sub シート1において$C$40または$C$42または$C$44のいずれかを変更した場合 最後に変更したセルに対し、シート2にオートフィルタ―がかかる様にしたいと思っています。 試しにシート1を以下のように編集したところ、思った動作を行ったのですが $C$40または$C$42または$C$44のいずれかのセルを空白にすると エラーがでてしまいます。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:C").AutoFilter field:=1, Criteria1:=Target.Value End Sub Then Exit Subをどう編集すれば上手く動作するでしょうか？

  • エクセルＶＢＡで住所録を作成

    住所録シートに次のようにコードを作っています。 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$B$1" Then 顧客名検索 ElseIf Target.Address = "$C$1" Then フリガナ検索 ElseIf Target.Address = "$D$1" Then 住所検索 ElseIf Target.Address = "$E$1" Then 郵便番号検索 ElseIf Target.Address = "$A$1" Then オートフィルタ解除 カナ順に設定 Else Exit Sub End If End Sub そして標準モジュールには Sub 顧客名検索() ans = InputBox("顧客名を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=2, Criteria1:="=*" & ans & "*" '2つ目のフィルターに検索文字 End With End Sub Sub フリガナ検索() ans = InputBox("顧客カナを入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=3, Criteria1:="=*" & ans & "*" '3つ目のフィルターに検索文字 End With End Sub Sub 住所検索() ans = InputBox("住所を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=4, Criteria1:="=*" & ans & "*" '4つ目のフィルターに検索文字 End With End Sub Sub 郵便番号検索() ans = InputBox("郵便番号を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=5, Criteria1:="=*" & ans & "*" '5つ目のフィルターに検索文字 End With End Sub Sub オートフィルタ解除() Application.CutCopyMode = False Selection.AutoFilter Range("A1").Select End Sub Sub カナ順に設定() Range("C1").Select ActiveWorkbook.Worksheets("住所録").Sort.SortFields.Clear ActiveWorkbook.Worksheets("住所録").Sort.SortFields.Add Key:=Range("C1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("住所録").Sort .SetRange Range("A2:IV65536") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A2").Select Selection.AutoFilter End Sub と入れています。 VISTAで作ったのですが、このファイルを共有にして使おうとすると、XPのパソコンでは、A1セルをダブルクリックすると、コードが黄色になり、マクロが中断されます。 B1～G1は問題なくマクロが実行されるのに・・・。 もう一台のVISTAでは同じ共有状態で使っても問題ありません。 どうすればXPでも問題なく使えるのでしょう?

  • Excelマクロでオートフィルターからコピペ

    ファイルのB列の値から0以外の値をオートフィルターで抽出し、値を、別のファイルのD列の一番下に貼りつけるマクロを作っていますがうまくいきません。 今作ったのは Sub macro1() If ActiveSheet.AutoFilterMode = False Then Range("A:G").Select Selection.AutoFilter Else Selection.AutoFilter Range("A:G").Select Selection.AutoFilter End If Selection.AutoFilter Field:=2, Criteria1:="<>0", Operator:=xlAnd Range("A1").Select Range("B2", Range("B2").End(xlDown)).Select Selection.Copy Windows("貼りつけるファイル名").Activate Cells(Rows.Count, 4).End(xlUp).Offset(1).Select ActiveSheet.Paste End Sub です。 フィルターで0以外の値を抽出しコピーまではできていますが、貼りつけるところでエラーがでます。 Microsoft Visual Basic 400 というエラーです。 何が悪いのか分かりません・・・。 分かる方いましたらご教授ください。よろしくお願いします。

  • オートフィルタ　マクロについて

    質問です。 オートフィルタで複数列を1つの条件で抽出したいのですが、教えてください。 たとえばA列が納品書No.・B列が受注No.・C列が商品No.なのですがすべて数字の為、出来ればInBox一回でA-C列を検索してほしいです。 指定納品書NO 受注NO 元品番 21812 3252608 77 21880 3307989 32B 22053 3389769 95414A 22050 3389770 67312H 22052 3389771 67312H 22050 3389773 67118H 以下の様なマクロを作ってみましたが、 A-C列全てに一致しないと抽出しないようです。 どなたかご教授いただけないでしょうか？ マクロ '条件1 の設定 Dim 検索NO As Variant '抽出キーの入力指示 検索NO = InputBox("検索NOを入力てください。") 'キャンセルした場合の処理 If 検索NO = Empty Then Exit Sub End If 'オートフィルタがかかっていなかったらかける 'かかっていたら念の為一度解除し再設定 If ActiveSheet.AutoFilterMode = False Then Range("A2:O2").Select Selection.AutoFilter Else Selection.AutoFilter Range("A2:O2").Select Selection.AutoFilter End If Selection.AutoFilter Field:=1, _ Criteria1:=">=" & 検索NO, Operator:=xlAnd, Criteria2:=" " & 検索NO Selection.AutoFilter Field:=2, _ Criteria1:=">=" & 検索NO2, Operator:=xlAnd, Criteria2:=" " & 検索NO2 Selection.AutoFilter Field:=3, _ Criteria1:=">=" & 検索NO3, Operator:=xlAnd, Criteria2:=" " & 検索NO3 AutoFilterMode = False Application.ScreenUpdating = True End Sub よろしくお願いいたします。

  • オートフィルタで未入力（空白）を無視した抽出法

    いつもお世話になっております。 現在第一条件から第三条件までの入力フォームを作成し、その条件に基づいたオートフィルタを作成中なのですが、 第二条件以下に未入力の場合のオートフィルタができなくて困っています。 これら未入力（空白）でもきちんと抽出できるオートフィルタを作るにはどうしたら良いですか？ 以下に私が作成したものを転記いたしますので、どなたかご教示くださいますよう、お願いいたします。 With Worksheets("業種別検索") myCriteria1 = .Range("a2").Value myCriteria2 = .Range("b2").Value 　　　　 myCriteria3 = .Range("c2").Value End With With Worksheets("元データ") If Worksheets("元データ").AutoFilterMode = False Then Range("A6:z6").Select Selection.AutoFilter Else Sheets("元データ").Select Selection.AutoFilter Range("A6:z6").Select Selection.AutoFilter End If .Range("A1").CurrentRegion.AutoFilter 17, myCriteria1, xlAnd .Range("A1").CurrentRegion.AutoFilter 18, myCriteria2, xlAnd .Range("A1").CurrentRegion.AutoFilter 19, myCriteria3, xlAnd End With

  • ダブルクリックでエクセル起動

    セルをダブルクリックしてマクロを起動させたいのですが。 B1セルをダブルクリックすると、 Sub 顧客名検索() ans = InputBox("顧客名を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=2, Criteria1:="=*" & ans & "*" '2つ目のフィルターに検索文字 End With End Sub を実行させるようにしたいのです。 その方法で、C1、D1、E1、・・・も同様にしたいと思っています。 どなたか教えてください。

  • 型が一致しない　というエラー

    Private Sub Worksheet_Change(ByVal Target As Range) If Target = Range("B1") Then Range("B3:B8").Select Selection.ClearContents End If End Sub というコードを書いています。 Ｂ３～Ｂ８は「数字」という書式です。 型が一致しない１３番のエラーが出ます。 原因と対処法を教えてください。 宜しくお願いします。

  • VBAがうまく動作しません

    以下のようなマクロを組んでいるのですが 指定したセルの内容をDeleteした場合に 型が一致しませんというエラーが発生します エラーが出るのはDeleteした場合のみで 他の操作ではエラーになりません どのように変更したらよいでしょうか？ Private Sub worksheet_change(ByVal Target As Excel.Range) If Application.Intersect(Target, Range("C40:C45")) Is Nothing Then Exit Sub If Target = "" Then Worksheets("リスト").AutoFilterMode = False: Exit Sub Worksheets("リスト").Range("A:I").AutoFilter field:=1, Criteria1:=Target.Value End Sub

  • [VBA]型が一致しません

    EXCELWORKSHEET上で下記の処理をすると「型が一致しません」との エラーがでます。どうにも原因と対応策がわからず悩んでいます。 デバッグの良い方法ありませんでしょうか？ ＜現象＞ ＊列2上のセルを選択して、DELETEキーを押す。⇒エラーなし。 ＊しかし、列2上のセルとその他のセルを同時選択した上で、DELETEキーを押すと「型が一致しません。」のエラー。 頭の「If Target.Column Like 2 And Len(Target.Value) > 0 Then 」が悪さしているのはわかるのですが・・・。 Private Sub WORKSHEET_CHANGE(ByVal Target As Range) If Target.Column Like 2 And Len(Target.Value) > 0 Then Range("c" & Target.Row).Value = Now If Target.Column Like 2 And Len(Target.Value) > 0 Then 'B列の場合だけ確認 Dim rng As Range Set rng = ActiveSheet.Range("B:B").Find(What:=Target, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, MatchByte:=True) If Not rng Is Nothing Then '発見した。 If rng.Address <> Target.Address Then '入力中セル以外で発見 Select Case MsgBox("過去に受け入れたLOTです。再度受入れますか？", vbYesNo) Case vbYes Range("B2").Activate Selection.End(xlDown).Select ActiveCell.Offset(0, 1).Activate ActiveCell.Value = Now ActiveCell.Offset(0, 1).Activate ActiveCell.Value = UserForm2.TextBox2.Value UserForm2.TextBox1.Value = "" UserForm2.TextBox2.Value = "" UserForm2.TextBox1.SetFocus Range("B2").Activate Selection.End(xlDown).Select Selection.Offset(1, 0).Select Case vbNo Range("B2").Activate Selection.End(xlDown).Select ActiveCell.ClearContents ActiveCell.Offset(0, 1).Activate ActiveCell.ClearContents UserForm2.TextBox1.Value = "" UserForm2.TextBox2.Value = "" UserForm2.TextBox1.SetFocus End Select End If End If End If End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する