• ベストアンサー

書いたコードが思惑通りに動かないです。

アクティブシートのセル値を"データ"シートに転記するコードのつもりです。 If Cells(gyou, "CB").Value = 0 Then Exit Sub で変更したセルの行のCB列が零なら処理を終了してほしいのにそのまま処理が続く点と、 kennsakekka = Application.WorksheetFunction.Match(banngou, x, 0) を使って重複の有無を確認し、上書きや処理中止の選択をしたいのですが、重複の有無にかかわらず転記されます。 特別エラーは出ないため、原因が分からず困っています。 不具合の原因がどこにあるのか教えていただけないでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim gyou, katann, banngou, kennsakekka, x gyou = Target.Row If Target.Column <> 6 Then Exit Sub 'F列以外の変更なら処理を終了 If Cells(gyou, "CB").Value = 0 Then Exit Sub '変更したセルの行のCB列が零なら処理を終了 x = Worksheets("データ").Range("$A$2:$A$65536")   'xにシート"データ"のセル範囲を入れる banngou = Target.Value katann = Worksheets("データ").Cells(Rows.Count, "A").End(xlUp).Offset(1).Row kennsakekka = Application.WorksheetFunction.Match(banngou, x, 0) If kennsakekka = "" Then '重複項目がない場合はシート"データ"の終端の1つ下の行に転記 Worksheets("データ").Cells(katann, "A").Value = ActiveSheet.Cells(gyou, "CA").Value Else Dim ans As Integer ans = MsgBox("記入済の番号です。上書きしますか?", vbYesNo + vbExclamation, "確認してください") Select Case ans Case vbYes     'はいを選択したらMatchで見つけた行に上書き Worksheets("データ").Cells(kennsakekka, "A").Value = ActiveSheet.Cells(gyou, "CA").Value Case vbNo     'いいえを選択したら処理を終わる Exit Sub End Select End If End Sub

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。 配列を入れるという意味が分かりません。 >x = Worksheets("データ").Range("$A$2:$A$65536") Set x = Worksheets("データ").Range("$A$2:$A$65536") 以下は、ありえないです。 >kennsakekka = Application.WorksheetFunction.Match(banngou, x, 0) >If kennsakekka = "" Then このコードの感じからすると、 kennsakekka = Application.Match(banngou, x, 0) If IsError(kennsakekka) Then シートモジュールですから、 Worksheets("データ").Cells(katann, "A").Value = Cells(gyou, "CA").Value ということかな? If MsgBox("記入済の番号です。上書きしますか?", vbYesNo + vbExclamation, "確認してください") = vbYes Then Worksheets("データ").Cells(kennsakekka, "A").Value = Cells(gyou, "CA").Value End If End If それをまとめてみると、以下のようになります。ただ、F列に入力して、CA列をデータ・シートにコピーするのに、F列の値で、重複を調べるというのは、なんだか意味が良く分からないです。 Private Sub Worksheet_Change(ByVal Target As Range)   Dim gyou As Long, katann As Long, banngou As Variant   Dim kennsakekka As Variant   Dim x As Range      If Target.Column <> 6 Then Exit Sub 'F行   If Target.Count > 1 Then Exit Sub 'セルを二つ以上選択した場合   If Target.Value = "" Then Exit Sub 'データの空の場合      gyou = Target.Row      If Cells(gyou, "CB").Value = 0 Or Cells(gyou, "CB").Value = "" Then Exit Sub      Set x = Worksheets("データ").Range("A1:A65536")   'xにシート"データ"のセル範囲を入れる      banngou = Target.Value 'F列のデータ      kennsakekka = Application.Match(banngou, x, 0)      If IsError(kennsakekka) Then      Worksheets("データ").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = _      Cells(gyou, "CA").Value   Else     If MsgBox("記入済の番号です。上書きしますか?", _     vbYesNo + vbExclamation, "確認してください") = vbYes Then        Worksheets("データ").Cells(kennsakekka, "A").Value = _        Cells(gyou, "CA").Value     End If   End If End Sub

kobuta2008
質問者

お礼

返事が遅くなりました。 説明不足にも関わらず親切なアドバイスありがとうございます。 これからいただいた意見を参考に試し、結果をお伝えします。 >x = Worksheets("データ").Range("$A$2:$A$65536")と Set x = Worksheets("データ").Range("$A$2:$A$65536")の違いがわからないのですが、Setの有無で意味が全然違うということなのでしょうね。これから調べます。 同じコードのシートが複数あり、記入された情報をvlookup関数で取得するためにデータシートにまとめています。 入力されたデータの転記はVBAで賄えるのかもしれませんが、今の私の力では少し複雑なコードになりそうなので、他のセルたちに入力された値をもとに、一度普通の関数で必要な情報をCA列からCGにまとめ(実際に転記させるセルは複数あります)、その値を転記するだけのコードを書くことにしました。 F列に入力された数値もそのうちの1つで、vlookupで検索する値で、転記するセル群の1つに入力されています。F列の値で検索よりも、CA列の値で重複検索をする形にしておけば理解していただけたかもしれませんね。

その他の回答 (2)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんばんは。 #2の回答者です。真夜中だったので、私の回答が雑だったかもしれません。 >>x = Worksheets("データ").Range("$A$2:$A$65536")と >Set x = Worksheets("データ").Range("$A$2:$A$65536")の違いがわからないのですが、Setの有無で意味が全然違うということなのでしょうね。 これは、VBAなどの 旧VB系の特徴です。今回は、その後で、MATCH関数を使っていますから、MATCH 関数は、2次元配列は受け取れません。MATCH(検索値,範囲、オプション)ですから、範囲は、Range 型でないといけませんね。 いっそうのこと、全部、VBAで作ってしまったほうが、逆に、楽なのかなとは思いますが、 >今の私の力では少し複雑なコードになりそうなので、 今のレベルからなら、そんなに心配ないと思います。今の内容自体まで作れる方なら、後は、回答者さんたちのアドバイスで、問題なく、出来上がると思いますね。大丈夫です! もう少し、細かいところが分かると良いのですが、当面の返事だけつけておきます。

kobuta2008
質問者

お礼

できました!! 教えてもらった If IsError(kennsakekka) Then に変えたら思惑通りに動きました♪ 上書きする選択をした時、実際に重複している行の1つ上の行に上書きされたので Set x = Worksheets("データ").Range("$A$1:$A$65536") と検索範囲をA1からに変更しました。 上書き先を Worksheets("データ").Cells(kennsakekka, "A").Value = としていしているのに、項目行を省いた$A$2:$A$65536が指定範囲ではずれが生じるのは当然でしたね。 本当に助かりました。 1つ謝らなければならない事があります。 実は昨日作業していた時のコード記入先シートと、試験操作で使用したシートが違っていました。いくらコードを訂正しても変化が起こるはずもないどうしようもないミスでした。 作成中のファイルはまだ未完成で、これからいろいろ試しながら完成を目指す予定です。 お世話になりました。

noname#79209
noname#79209
回答No.1

当てずっぽうですが... Cells(gyou, "CB").Value が「0」でなく「""」とか...

kobuta2008
質問者

お礼

回答ありがとうございます。 確かに、そのセルにはif関数が入っています。 0から""に変えてやってみます。

関連するQ&A