質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.61%

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

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 867
退会済みユーザー

退会済みユーザー

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

【やりたいこと】

①Sheet1
イメージ説明

②Sheet2
イメージ説明

③結果
![イメージ説明説明]

【プログラム】

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

【悩んでいること】

イメージ説明

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

【コード】

Option Explicit

Private Sub Test()

'++++ファイル
Dim wb As Workbook                   'ファイルのワークブック格納

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

Dim ws_SubSheet As Worksheet         'Sheet2シート名格納
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列にスペースが入っているのでちゃんと動きません。
(スペースは全角、半角、または半角を2つなど色々なパターンがあります)

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

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

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

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

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

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

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

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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • mdj

    2019/11/12 17:35

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

    キャンセル

  • 退会済みユーザー

    退会済みユーザー

    2019/11/12 17:48

    ありがとうございます。
    すみませんが、これは
    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

    2019/11/12 21:01

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

    キャンセル

回答 2

checkベストアンサー

+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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/11/12 23:30

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

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

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

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

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

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

    キャンセル

  • 2019/11/12 23:58

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

    キャンセル

  • 2019/11/13 00:23

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

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

    キャンセル

0

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/11/12 22:22

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

    キャンセル

  • 2019/11/12 22:29

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.61%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る

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