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

VBAの素人で、基礎が理解できていないレベルです。googleなどで調べて、以下まで出来るようになりましたが、できない部分があり、質問させて頂いています。
以下について、ご教示頂けると大変助かります。
添付のVBAについて、

■やっている事

その① 2つのシートの、同一位置にあるセルの値を比較する。

その② 別シートを作成して、その①の処理で異なる値となったセルの値に、「薄い黄色の網掛け」と「フォントを赤にして」表示する。

■やりたいけど、できない事

上述のその②ですが、別シートのセルに出力されている「値」は、現状では「比較したいシート(1枚目)の「値」」が設定されていますが、

そうではなくて、「比較したいシート(1枚目)の値」と「比較したいシート(2枚目)の値」との差額を設定したいのです。

なお、セルの値が、数値ではなくて、文字列であった場合は、エラー値を出し、数値が入っているセルのみを、その差額を出したいです。



◆◆◆

Sub シート比較()

Dim SN1 As String, SN2 As String, 比較結果 As String, buf As Range, TCell As Range

'Step1:比較したいシート(1枚目)の比較したい範囲を選択

Set buf = Application.InputBox(prompt:="比較したいシート(1枚目)の「範囲」を選択してください)", Type:=8)

SN1 = buf.Parent.Name

'Step2:比較したいシート(2枚目)の名前を入力。デフォルト値は2枚目のシート

SN2 = InputBox("比較したいシート(2枚目)の「シート名」を入力してください", "", Sheets(2).Name)

'Step3:突合結果の追加

Worksheets(SN1).Copy Before:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

ActiveSheet.Name = "比較結果"

'Step4:指定した各セル内容を比較していき、結果シートに記入する。

For Each TCell In buf

'結果シートの対応するセルに比較シート1の値を記入していく

Sheets("比較結果").Range(TCell.Address).Formula = TCell.Formula

'比較シート1と2の値を比較し異なる場合には、結果シートの対応するセルを色をつけていく。同一であれば色はつけない。

If TCell.Value <> Sheets(SN2).Range(TCell.Address).Value Then

Sheets("比較結果").Range(TCell.Address).Interior.Color = RGB(255, 255, 153)

Sheets("比較結果").Range(TCell.Address).Font.Color = RGB(255, 0, 0)

Sheets("比較結果").Range(TCell.Address).Font.Name = "Meiryo UI"

Sheets("比較結果").Range(TCell.Address).Font.Size = 9

Else

Sheets("比較結果").Range(TCell.Address).Interior.Color = RGB(255, 255, 255)

Sheets("比較結果").Range(TCell.Address).Font.Color = RGB(0, 0, 0)

Sheets("比較結果").Range(TCell.Address).Font.Name = "Meiryo UI"

Sheets("比較結果").Range(TCell.Address).Font.Size = 9

End If

Next

End Sub

◆◆◆

よろしくお願い致します。

A 回答 (1件)

Sub シート比較()



Dim SN1 As String, SN2 As String, 比較結果 As String, buf As Range, TCell As Range

For i = 1 To Worksheets.Count
If Worksheets(i).Name = "比較結果" Then
Sheets("比較結果").Select
ActiveWindow.SelectedSheets.Delete
Exit For
End If
Next i
Sheets("Sheet1").Select

'Step1:比較したいシート(1枚目)の比較したい範囲を選択
Set buf = Application.InputBox(prompt:="比較したいシート(1枚目)の「範囲」を選択してください)", Type:=8)
SN1 = buf.Parent.Name

'Step2:比較したいシート(2枚目)の名前を入力。デフォルト値は2枚目のシート

SN2 = InputBox("比較したいシート(2枚目)の「シート名」を入力してください", "", Sheets(2).Name)

'Step3:突合結果の追加
Worksheets(SN1).Copy Before:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "比較結果"

'Step4:指定した各セル内容を比較していき、結果シートに記入する。
For Each TCell In buf
'結果シートの対応するセルに比較シート1の値を記入していく
Sheets("比較結果").Range(TCell.Address).Formula = TCell.Formula

'比較シート1と2の値を比較し異なる場合には、結果シートの対応するセルを色をつけていく。同一であれば色はつけない。
If VarType(Range(TCell.Address).Value) = vbString Then
Range(TCell.Address) = "1枚目文字列!"
ElseIf VarType(Sheets(SN2).Range(TCell.Address).Value) = vbString Then
Range(TCell.Address) = "2枚目文字列!"
ElseIf TCell.Value <> Sheets(SN2).Range(TCell.Address).Value Then
Sheets("比較結果").Range(TCell.Address).Interior.Color = RGB(255, 255, 153)
Sheets("比較結果").Range(TCell.Address).Font.Color = RGB(255, 0, 0)
Sheets("比較結果").Range(TCell.Address).Font.Name = "Meiryo UI"
Sheets("比較結果").Range(TCell.Address).Font.Size = 9
Sheets("比較結果").Range(TCell.Address) = Range(TCell.Address).Formula - Sheets(SN2).Range(TCell.Address).Value
ElseIf TCell.Value = Sheets(SN2).Range(TCell.Address).Value Then
Sheets("比較結果").Range(TCell.Address).Interior.Color = RGB(255, 255, 255)
Sheets("比較結果").Range(TCell.Address).Font.Color = RGB(0, 0, 0)
Sheets("比較結果").Range(TCell.Address).Font.Name = "Meiryo UI"
Sheets("比較結果").Range(TCell.Address).Font.Size = 9
Sheets("比較結果").Range(TCell.Address) = Range(TCell.Address).Formula - Sheets(SN2).Range(TCell.Address).Value
End If
Next
End Sub



こんなんしてみました。
    • good
    • 0
この回答へのお礼

かわごえ 様

迅速なアドバイス有難く感謝致します。
早速、書いて動かして見ます。
有難うございました。

お礼日時:2018/06/18 15:52

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