プロが教えるわが家の防犯対策術!

たびたび申し訳ないです。

エクセル2003ですが、シート2のデータをシート1のA列にある日付と1行目にある製品名とで検索をかけて当てはまるセルにシート2のデータを転記する(下記記載)コードがあります。当てはまるセルがないときはシート2の対応するセルが赤く反転するエラー処理がなされています。
以前こちらで教えていただいたのですが、このコードに更に下記のようにシート1の当てはまるセルが入力済みならば上書きしますかと言う

Worksheets("Sheet1").Cells(trgR, trgC) <>""Then
If MsgBox("上書きしますか", vbQuestion + vbOKCancel) = vbOK Then
Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 3)

このようなコードをさらに付け加えたいのですが、どのようにすればいいかご教授願います。1週間いろいろやってみたのですがうまくいきません。赤く反転するエラー処理もそのまま生かしておきたいのです。長い質問で申し訳ありませんがよろしくお願いいたします。



元のコードです。
Private Sub CommandButton1_Click()
Dim LastR, idxR As Long, trgR, trgC
With Worksheets("Sheet2")
LastR = .Range("A65536").End(xlUp).Row
trgR = Application.Match(.Cells(1, 1), Worksheets("Sheet1").Range("A:A"), 0)
For idxR = LastR To 3 Step -1
trgC = Application.Match(.Cells(idxR, 1), Worksheets("Sheet1").Range("1:1"), 0)
If IsNumeric(trgR) And IsNumeric(trgC) Then
Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 3)

Else
.Cells(idxR, 1).Interior.ColorIndex = 3
End If
Next idxR
End With

End Sub

A 回答 (1件)

そこまでできてるなら、こんな感じでそのまま追加するだけで良いと思います。



Private Sub CommandButton1_Click()
  Dim LastR, idxR As Long, trgR, trgC
  With Worksheets("Sheet2")
    LastR = .Range("A65536").End(xlUp).Row
    trgR = Application.Match(.Cells(1, 1), Worksheets("Sheet1").Range("A:A"), 0)
    
    For idxR = LastR To 3 Step -1
      trgC = Application.Match(.Cells(idxR, 1), Worksheets("Sheet1").Range("1:1"), 0)
      
      If IsNumeric(trgR) And IsNumeric(trgC) Then
        If Worksheets("Sheet1").Cells(trgR, trgC) <> "" Then
          If MsgBox("上書きしますか", vbQuestion + vbOKCancel) = vbOK Then
            Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 3)
          End If
        End If
      Else
        .Cells(idxR, 1).Interior.ColorIndex = 3
      End If
    Next idxR
  
  End With

End Sub
    • good
    • 0

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