ＶＢＡ：同じ文字列データの比較がうまくいかない例

質問

ＶＢＡ初心者です。シート"Ｍ"からA列の契約番号の複数必要データを変数入力し、別シート"A"に場所を探した出したうえで転記するプログラムが動きません。改良点が分からず困っております。どなたかご教示いただけると大変助かります。

（具体的な内容）
シート"Ｍ"は元のデータが入っているシートです。このシートのＡ列に入っている契約番号の行の列にある複数コラムのデータを、同ブック内にあるシート”Ａ”にある表に、契約番号を検索キーにし検索し場所を探し出し後、転記をするプログラムを組もうとしましたが以下の状況が発生しうまく動きませんでした。

私の以下のプログラムでは、シート"M"で必要な情報を変数var1, var2,var3,var4に代入した後、シート”Ａ”に移り、検索キーとなるシート"A"内の契約番号を　If r.Value = var1 という数式の内容で探し出そうとしています。

この過程をWatchウィンドウで確認したところ同じ文字列が入っているにもかかわらず、同一とみなされずデータの転記をせずに通り過ぎてしまいました。

何が悪いのでしょうか。いろいろと手を変え品を変え試しましたがうまく動かず困っています。
ご教示いただけますと大変助かります。　どうかよろしくお願いいたします。

--------------------------------------
Sub データ転記プログラムテスト()
'変数宣言
Dim sh1, sh2
Set sh1 = Worksheets("M")
Set sh2 = Worksheets("A")
Dim 先頭行 As Long
Dim 末尾行 As Long
Dim 行番号 As Long
Dim var1 As String
Dim r As Range

sh1.Select
'データの一行目から1列目、3列目のデータを変数var1, var2に取り込む
先頭行 = 2
末尾行 = Range("A1").CurrentRegion.Rows.Count

For 行番号 = 先頭行 To 末尾行 Step 1

var1 = Cells(行番号, 1)
var2 = Cells(行番号, 9)
'var3 = Cells(行番号, 10)
'var4 = Cells(行番号, 11)

sh2.Select
On Error Resume Next
'---Ｓｈｅｅｔ２で該当行を探す
For Each r In Range("A6:A216")
If r.Value = var1 Then '←ここでr.Value とvar1が同じデータが入っているのに違うとみなされます。どのように対処すればよいでしょうか。(Watch Windowで同じ値が入っていることを確認済みです。）

r.Font.Color = vbBlue
sh2.Cells(r, "J") = var2
sh2.Range("J" & r).Font.Color = RGB(0, 112, 192)
sh2.Cells(r, "K") = var3
sh2.Range("K" & r).Font.Color = RGB(0, 112, 192)
sh2.Cells(r, "L") = var4
sh2.Range("L" & r).Font.Color = RGB(0, 112, 192)
'ActiveCell.Select
'Selection.Font.ColorIndex = 5
Else
End If

Next r
If 行番号 = 末尾行 Then
MsgBox ("データ転記が終了しました")
End If
Next 行番号

End Sub

回答No.2

tom04 · ベストアンサー

No.1です。

コードをよく見させてもらいました。
結局こういうコトをしたいのでしょうか？

Sheet「A」のA列に重複がないのであれば簡単ですが、そこら辺は実際のデータが判らないので
コードで判断して、両方のコードを載せておきます。
標準モジュールにコピー＆ペーストしてマクロを試してみてください。

Sub Sample1() 'Sheet「M」に重複がない場合
Dim i As Long, k As Long, c As Range
Dim wS1 As Worksheet, wS2 As Worksheet, myArray
Set wS1 = Worksheets("M")
Set wS2 = Worksheets("A")
For i = 2 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
Set c = Range(wS2.Cells(6, "A"), wS2.Cells(216, "A")).Find(what:=wS1.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
wS2.Cells(c.Row, "A").Font.Color = vbBlue
With wS2.Cells(c.Row, "J").Resize(, 3)
.Value = wS1.Cells(i, "I").Resize(, 3).Value
.Font.Color = RGB(0, 112, 192)
End With
End If
Next i
End Sub

Sub Sample2() 'Sheet「M」に重複がある場合
Dim i As Long, k As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("M")
Set wS2 = Worksheets("A")
For i = 2 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
For k = 6 To 216
If wS1.Cells(i, "A") = wS2.Cells(k, "A") Then
wS2.Cells(k, "A").Font.Color = vbBlue
With wS2.Cells(k, "J").Resize(, 3)
.Value = wS1.Cells(i, "I").Resize(, 3).Value
.Font.Color = RGB(0, 112, 192)
End With
End If
Next k
Next i
End Sub

※　実際のレイアウトが判れば具体的なアドバイスができると思います。
まずはこの程度で・・・m(_ _)m

お礼

他にいただいたアドバイスでもうまく動かなかったのでいただいたコードを使わせていただきました。
いままで1時間以上かけていた作業が一瞬でおわり、感謝の一言に尽きます。このコードを転用させていただきます。

本当にありがとうございました。

回答No.6

30246kiku

＃５です

シート「M」「A」の解釈・扱いが逆でした。
考え方だけでも参考になれば

お礼

ご親切にご教授ありがとうございました。
Range　Cell のまとめなど大変勉強になりました。
ありがとうございました。

回答No.5

30246kiku

> If r.Value = var1 Then

変数の型とか大丈夫なんでしょうか
同じ値なのかどうか、VBA ではなく EXCEL さんにやってもらうとか
以下でどうなりますか

Public Sub Samp1()
　　Dim ws As Worksheet
　　Dim iRow As Long
　　Dim rng As Range, r As Range
　　Const CCMOJI As String = "=IF(RC[+1]=A!R{%1}C1,1,"""")"

　　Set ws = Worksheets("A")
　　Worksheets("M").Select
　　Columns(1).Insert

　　With Range("A6:A216")
　　　　For iRow = 2 To ws.Range("A1").CurrentRegion.Rows.Count
　　　　　　.FormulaR1C1 = Replace(CCMOJI, "{%1}", iRow)
　　　　　　.Value = .Value
　　　　　　On Error Resume Next
　　　　　　Set rng = .SpecialCells(xlCellTypeConstants, xlNumbers)
　　　　　　If (Err = 0) Then
　　　　　　　　For Each r In rng
　　　　　　　　　　r.Offset(, 1).Font.Color = vbBlue
　　　　　　　　　　With r.Offset(, 10).Resize(, 3)
　　　　　　　　　　　　.Value = ws.Cells(iRow, 9).Resize(, 3).Value
　　　　　　　　　　　　.Font.Color = RGB(0, 112, 192)
　　　　　　　　　　End With
　　　　　　　　Next
　　　　　　End If
　　　　Next
　　End With

　　Columns(1).Delete
　　Set ws = Nothing
End Sub

シート「M」に作業用の列を１列目に入れて
・隣のものと、シート「A」の比較対象のものが同じなら 1 を
結果を即値にして、数値部分を抽出して・・・・
数値のものがなかったらエラーになるので・・・・

お礼

お礼が遅れた異変失礼いたしました。

サンプルプログラム大変参考になりました。
どうもありがとうございました。

細谷

回答No.4

nishi6

気が付いた点をモジュール内部に記入してみました。

〇第一の問題点は「Range("A6:A216")」で、これではsh1を調べています。sh2.Range("A6:A216") とします。
〇また、「r」はRangeですが、「sh2.Cells(r, "J") = var2」では、このセルの値を書き換えの行番号にしています。多分違うと思うので探した行を「rw」で定義しています。

差し出がましいですが、他に
〇書き換えで、CellsとRangeがあるので統一しました。
〇For～Next でNextの次の変数はない方がすっきりします。
〇「On Error Resume Next」だと、エラーが起きても正常に終わります。
〇For Loopの中で最終行を判定してメッセージを出していますが、ループの外がいいでしょう。このとき「行番号=末尾行+1」です。
〇For Loopの「Step1」は不要です。

Sub データ転記プログラムテスト()
　　'変数宣言
　　Dim sh1, sh2
　　　　Set sh1 = Worksheets("M")
　　　　Set sh2 = Worksheets("A")
　　Dim 先頭行 As Long
　　Dim 末尾行 As Long
　　Dim 行番号 As Long
　　Dim var1 As String, var2 As String, var3 As String, var4 As String
　　Dim r As Range

　　Dim rw As Long '// *** 追記 ***

　　sh1.Select
　　'データの一行目から1列目、3列目のデータを変数var1, var2に取り込む
　　先頭行 = 2
　　末尾行 = Range("A1").CurrentRegion.Rows.Count

　　For 行番号 = 先頭行 To 末尾行 Step 1　　'// Step 1 は不要
　　　　var1 = sh1.Cells(行番号, 1) 　　'// 分かりやすくするために追記
　　　　var2 = sh1.Cells(行番号, 9) 　　'// 分かりやすくするために追記
　　　　var3 = sh1.Cells(行番号, 10)　　'// 分かりやすくするために追記
　　　　var4 = sh1.Cells(行番号, 11)　　'// 分かりやすくするために追記

　　　　'sh2.Select　　　'// sh2 を定義しているのだから無くていい

　　　　On Error Resume Next　　'// エラーがあっても正常終了させる？

　　　　'---Ｓｈｅｅｔ２で該当行を探す
　　　　For Each r In sh2.Range("A6:A216") '// sh2. 追記
　　　　　　If r.Value = var1 Then
　　　　　　　　rw = r.Row　　　　　　'// 見つけた行
　　　　　　　　r.Font.Color = vbBlue
　　　　　　　　sh2.Range("J" & rw) = var2
　　　　　　　　sh2.Range("J" & rw).Font.Color = RGB(0, 112, 192)
　　　　　　　　sh2.Range("K" & rw) = var3
　　　　　　　　sh2.Range("K" & rw).Font.Color = RGB(0, 112, 192)
　　　　　　　　sh2.Range("L" & rw) = var4
　　　　　　　　sh2.Range("L" & rw).Font.Color = RGB(0, 112, 192)
　　　　　　　　'ActiveCell.Select
　　　　　　　　'Selection.Font.ColorIndex = 5
　　　　　　Else

　　　　　　End If
　　　　Next
　　Next

　　MsgBox ("データ転記が終了しました")

End Sub

回答No.3

WindFaller

こんばんは。

#1さんのいうトラブルが発生していることがあります。
（#2で既に出ているので、私は、あえてサンプルコードは書きません。)

標準モジュールで書いていたら、
ループの外で、sh1.Select をしているのですから、ループの中では、
var1 = Cells(行番号, 1)　は、最初は、sh1だったのが、二度目からは、sh2になっていますね。

シートモジュールで書いたら、Range("A6:A216")は、sh2.Select にしても、sh1を参照しているはずです。

どちらにしても、標準モジュールで、sh1 , sh2 をはっきりさせて書かなくてはなりませんね。

次は、参考までに……。

>　If r.Value = var1 という数式の内容で探し出そうとしています。

「検索キーとなるシート"A"内の契約番号」というのは、数字だけですか？
それとも、アルファベットや空白が入っているのではないでしょうか？

以下の例は、A1 に、"a" といれ、B1に、"A " ←空白が入っている
それでも、以下なら、同じだと出力されます。私は、こんなコードを使って文字列比較をします。

'//
Sub Test1()
　Dim Chr1 As String
　Dim sVal As String
　Chr1 = Trim(Range("A1").Value) '←ここがミソ1: Trim で空白を取る
　sVal = Trim(Range("B1").Value)
　If Chr1 <> "" And sVal <> "" Then
　　If StrComp(Chr1, sVal, vbTextCompare) = 0 Then　'←ここがミソ2:TextCompareをする
　　　MsgBox "Same", vbInformation
　　Else
　　　MsgBox "Different", vbExclamation
　　End If
　End If
End Sub
'//

お礼

ご教示ありがとうございます。ご指摘のとおり検索キーは文字列と数字列の混合で、ご教示いただいた空白等を処理するルーチンは大変勉強になりました。どうもありがとうございました。

回答No.1

tom04

こんばんは！
コードをざっと拝見して・・・

＞var1 = Cells(行番号, 1)
＞var2 = Cells(行番号, 9)
＞var3 = Cells(行番号, 10)
＞var4 = Cells(行番号, 11)
の行がSheetの指定がないので、アクティブSheetが対象になっていると思われます。

丁寧に
＞var1 = sh2.Cells(行番号, 1)
＞var2 = sh2.Cells(行番号, 9)
＞var3 = sh2.Cells(行番号, 10)
＞var4 = sh2.Cells(行番号, 11)
のようにSheetを指定したらどうなりますか？

詳しく検証していませんので
他の原因ならごめんなさいね。m(_ _)m

お礼

早速のご教示ありがとうございます。
ここの部分はvar1からvar4に変数が代入されているので
うまく稼動しているようです。

うまく動いていないのはこれより下の部分なので
他にもし思い浮かぶご助言がありましたらよろしくお願いいたします。

ほそたに