ExcelVBAでVlookupを使って値を取得する際、検索範囲の中にスペースが入っていると正しく取得されない

Question

お世話になっております。
現在、ExcelVBAの勉強をしているのですが以下の問題で色々と考えております。

【やりたいこと】

①Sheet1

②Sheet2

③結果
![説明]

【プログラム】

１：①のSheet1のA列に「Total」を結合させた文字列を作成
２：１の文字列をキーにしてVlookupでSheet2のA列を探し、見つかったらB列の値を①のD列にセット

【悩んでいること】

上記A列に「Total」を結合させた文字列をメインキーとして、
下記の図A１～B６の範囲をVlookupの検索範囲としたいが、
A列にスペースが入っているためきちんと参照できていない

【コード】

Option Explicit

Private Sub Test()
        
'++++ファイル
Dim wb As Workbook                   'ファイルのワークブック格納

Dim ws_MainSheet As Worksheet        'Sheet１シート名格納
Dim strMain_Lastcol As String        '最終行格納

Dim ws_SubSheet As Worksheet         'Sheet２シート名格納
Dim strSub_Lastcol As String         '最終行格納

Dim subTbl As Range                  'データを参照する範囲
Dim MainKey As String                'データのメインキー
Dim cnt  As Integer                  'For ～ Next のカウント変数

'++++定数
Const strPath As String = "C:\"
Const strFileName As String = "Vlookuptest.xlsm"
Const ws_Main_SheetName As String = "Sheet1"
Const ws_Sub_SheetName As String = "Sheet2"
Const Main_col As String = "A"
Const Assin_col As String = "D"


    'ファイルを開く
    Set wb = Workbooks.Open(strPath & "\" & strFileName)
    
    'ファイル内のメインシート（Sheet1）取得
    Set ws_MainSheet = wb.Worksheets(ws_Main_SheetName)
    ws_MainSheet.Activate
       
    'ファイル内のサブシート（Sheet2）取得
    Set ws_SubSheet = wb.Worksheets(ws_Sub_SheetName)
    ws_SubSheet.Activate
    
    '最終行をセット
    Call lastcol(ws_SubSheet, strSub_Lastcol)
    Set subTbl = ws_SubSheet.Range("A1:B" & strSub_Lastcol)
    
    'メインシートSheet1の最終行セット
    Call lastcol(ws_MainSheet, strMain_Lastcol)
    
    'ループ開始
    cnt = 2
    For cnt = 2 To strMain_Lastcol
    
        MainKey = ws_MainSheet.Range(Main_col & cnt).Value + "Total"
    
On Error GoTo ErrHandl

        'Vlookup
        Dim ret As String
        
　　　　'★★★
        ret = WorksheetFunction.VLookup(MainKey, subTbl, 2, False)
        ws_MainSheet.Range(Assin_col & cnt).Value = ret
    
    Next

Exit Sub
ErrHandl:
  ret = "該当なし"
  Err.Clear
  Resume Next

End Sub

Function lastcol(ws_Sheet As Worksheet, strCnt As String)

    '最終行を取得
    With ws_Sheet
        strCnt = .Cells(Rows.Count, 1).Row                 'Excelの最終行を取得
        strCnt = .Cells(strCnt, 1).End(xlUp).Row           '目的の列の最終行を取得
    End With
    
End Function

【問題点】

上記のコードだと、Sheet2のA列にスペースがない場合は問題なく動きます。
しかし、今回はSheet2のA列にスペースが入っているのでちゃんと動きません。
（スペースは全角、半角、または半角を２つなど色々なパターンがあります）

もしSheet2のA列にスペースがなくて、例えば「1月Total」と言うデータになっていれば
Sheet1のA列に「Total」を結合させた文字列をキーにしてすぐにVlookupができます。

でも、Sheet2のA列にスペースがあるからそれが難しいということで困っています。

なお、ワイルドカードを使えば？とおっしゃる方もいると思いますが、今回は検索範囲をあらかじめsubTblにセットしているのでどうやればいいのかも分かりません。

Vlookup関数を動かす前にあらかじめSheet2のA列からスペースを削除しておけばいいのだと思いますが、どうやればいいのかなと悩んでいます。

でもSheet2の方でA列のデータをコピーし、新しくC列に貼り付けて、そこでスペースを削除する、
その後、C列に対してVlookupを使うというのは不可、です。

どうやればSheet2のA列のスペースを削除した上でVlookup関数を動かすことができるのでしょうか？

ちなみに、別の列にあらかじめスペースを削除した値を貼り付けるというのはしないものとします。

どなたかご存知の方教えていただけると幸いです。
それではどうぞよろしくお願いいたします。

Comments

[mdj]

trim関数かSUBSTITUTE関数ではどうでしょうか。ソースは見てませんが。

[退会済みユーザー]

例えば、Vlookupの検索キーを1行ずつVlookup関数で参照するならそれもアリだと思います。
でも今回の場合は、検索キー（Sheet1シートのA列）ではなくて検索範囲（Sheet2シート）の方にスペースが入っているのです。
また、検索範囲は丸ごと変数にセットしてあります。
なので、検索範囲に対してTrimやSUBSTITLE関数は使えないのです。
その上で何かほかに方法はないのかを知りたいなと思って投稿させていただきました。

[mdj]

trim(ws_MainSheet.Range(Main_col & cnt).Value)じゃだめですか？

[退会済みユーザー]

ありがとうございます。
すみませんが、これは
MainKey = ws_MainSheet.Range(Main_col & cnt).Value + "Total"
これを
Mainkey = trim(ws_MainSheet.Range(Main_col & cnt).Value) + "Total"
にしたらどうか？という意味ですよね？

質問を読んでいただければ分かると思うのですが、ws_MainSheet,
つまりSheet1の方は空白は入っていないのです。

サブシート（Sheet2）のA列に空白があって、
そのサブシートが検索範囲となっています。
そしてこの検索範囲はsubTblに代入してあります。
そして、

ret = WorksheetFunction.VLookup(MainKey, subTbl, 2, False)

このコードでVlookupするのですが、
subTbl内に空白が入っているので正しくデータが取れないのが問題となっているのです。

[moh1ee]

subTblに入れる前にSheet2･A列を上から下までループするなりで空白を削除した値で書き換えればよいのでは？

Answer 1

VLOOKUPにこだわらず、Sheet2のA列を検索してはいかがでしょうか。
Private Sub Test()内の
MainKey = ws_MainSheet.Range(Main_col & cnt).Value + "Total"
を
MainKey = ws_MainSheet.Range(Main_col & cnt).Value
に変えます。
ret = WorksheetFunction.VLookup(MainKey, subTbl, 2, False)
を
ret = get_week(ws_SubSheet, strSub_Lastcol, MainKey)
に変えます。
そして、以下の関数を追加します。

Private Function get_week(ws As Worksheet, lastrow As String, key As String) As String
    Dim wrow As Long
    Dim result As Variant
    For wrow = 2 To CLng(lastrow)
        result = Cells(wrow, "A").Value Like key & "*Total"
        If result = True Then
            get_week = ws.Cells(wrow, "B").Value
            Exit Function
        End If
    Next
    get_week = "該当なし"
End Function

Comments

[退会済みユーザー]

申し訳ございません、私の説明が足りませんでした。

Sheet2のA列は、「1月　Total」「2月Total」・・・だけでなく、
例えば
Sheet2
A列
1月
1月
1月Total
2月
2月　Total
3月　　Total

・・というふうに、Totalがない値も存在します。

なので、教えていただいたコードを動かすと、A列の値が「1月」しかないものの列の
B列の値がコピーされてしまいます。

なので、やはりSheet1のA列に「Total」を結合させた文字列をキーにしないといけないようです。

せっかく考えていただいたのにすみませんがよろしくお願いいたします。

[tatsu99]

Private Function get_weekの内容を、変えました。
1月について言えば
"1月*Total"にマッチすれば、OKとなるようにしました。（*は任意のn文字）

[退会済みユーザー]

ありがとうございます。先ほどやってみたところ無事動きました。
すごいですね！
でも、このコードがどうして望む動きをしたのかまだよく分かっていません。。。
明日、もっとコードをよく見て解析してみます。

まずは、解決していただきありがとうございました！

Answer 2

Replace関数で空白を空文字にしてどうでしょうか？

Sub a()

    Dim a As String
    
    a = Cells(1, 1).Value
    Debug.Print a
    'あ　　　　う
    
    a = Replace(a, " ", "")
    a = Replace(a, "　", "")
    Debug.Print a
    'あう

End Sub

Comments

[退会済みユーザー]

申し訳ございません。
ちゃんと質問読んで、プログラムも実際に動かしてみていただけますか？？

[meg_]

sheet2のセルを上記コードのように編集すればvlookpが動くのではないでしょうか？