[[20150313135026]]　『VLOOKUPを利用したVBAを作成したい』（OPT）　ページの最後に飛ぶ

『VLOOKUPを利用したVBAを作成したい』（OPT）

はじめまして。

ある2つの表に対し、特定の文字列をキーにVLOOKUP関数で紐付けし、新しい表を作成したいと考えております。
（文字列の完全一致ではなく、一部が一致すればOK）

■特定の文字列
　表1 = グループ名
　表2 = ｻﾌﾞﾌﾟﾛｼﾞｪｸﾄ名

以下表がイメージとなりますが、この中で表1のグループ名と、表2のｻﾌﾞﾌﾟﾛｼﾞｪｸﾄ名の一部が一致すれば、表3のように情報をくっつけたいです。

表1
| A列 | B列 | C列 | D列 | E列 |

| No | ID | 氏名 | 所属 | グループ名 |

| 1 | test01 | 田中一郎 | システム1課 | tokitoki | -----------------------------------------
| 2 | test02 | 田中二郎 | システム2課 | tokitoki |

・
・
・

表2
| A列　　　 | B列　 |

| ﾌﾟﾛｼﾞｪｸﾄ名 | ｻﾌﾞﾌﾟﾛｼﾞｪｸﾄ名　|

| spring | tokitokiA |

| summer | momomomoB |

| autum | hogehogeB |

| winter | hohohohoA |

・
・
・

表3
| A列 | B列 | C列 | D列 | E列 | F列 | G列 |

| No | ID | 氏名 | 所属 | グループ名 | ﾌﾟﾛｼﾞｪｸﾄ名 | ｻﾌﾞﾌﾟﾛｼﾞｪｸﾄ名 |

| 1 | test01 | 田中一郎 | システム1課 | tokitoki | spring | tokitokiA | -----------------------------------------
| 2 | test02 | 田中二郎 | システム2課 | tokitoki | spring | tokitokiA |

・
・
・

宜しくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

表1：Sheet2
表2：Sheet3
表3：Sheet4（毎回作成するので、再度処理する場合は削除することを前提）
として、

Sub test()
Dim x As Integer
Dim y As Integer
Dim Aend As Integer
Dim Bend As Integer
Dim wknm As String

Sheets("Sheet2").Select
Sheets("Sheet2").Copy After:=Sheets(3)
Sheets("Sheet2 (2)").Select
Sheets("Sheet2 (2)").Name = "Sheet4"

Aend = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Bend = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Sheet4").Range("F1") = Sheets("Sheet3").Range("A1")
Sheets("Sheet4").Range("G1") = Sheets("Sheet3").Range("B1")

For x = 2 To Aend

    For y = 2 To Bend
        wknm = Left(Sheets("Sheet3").Range("B" & y), Len(Sheets("Sheet3").Range("B" & y)) - 1)
        If Sheets("Sheet2").Range("E" & x) = wknm Then
            Sheets("Sheet4").Range("F" & x) = Sheets("Sheet3").Range("A" & y)
            Sheets("Sheet4").Range("G" & x) = Sheets("Sheet3").Range("B" & y)
            Exit For
        End If
    Next y
Next x

End Sub
（コヨーテ） 2015/03/13(金) 17:11

少し前の内容になりますが、
＞・・・この中で表1のグループ名と、表2のｻﾌﾞﾌﾟﾛｼﾞｪｸﾄ名の一部が一致すれば・・・
という部分が考慮されていませんでした。

Sub test()
Dim x As Integer
Dim y As Integer
Dim Aend As Integer
Dim Bend As Integer
Dim wknm As String

Sheets("Sheet2").Select
Sheets("Sheet2").Copy After:=Sheets(3)
Sheets("Sheet2 (2)").Select
Sheets("Sheet2 (2)").Name = "Sheet4"

Aend = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Bend = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Sheet4").Range("F1") = Sheets("Sheet3").Range("A1")
Sheets("Sheet4").Range("G1") = Sheets("Sheet3").Range("B1")

For x = 2 To Aend

    For y = 2 To Bend
        wknm = Sheets("Sheet2").Range("E" & x)
        If Sheets("Sheet3").Range("B" & y) Like "*" & wknm & "*" Then
            Sheets("Sheet4").Range("F" & x) = Sheets("Sheet3").Range("A" & y)
            Sheets("Sheet4").Range("G" & x) = Sheets("Sheet3").Range("B" & y)
            Exit For
        End If
    Next y
Next x

End Sub
（コヨーテひな） 2015/03/23(月) 17:02

コメント返信：

[ 一覧(最新更新順) ]

[[20150313135026]] 『VLOOKUPを利用したVBAを作成したい』（OPT） ページの最後に飛ぶ

[[20150313135026]]　『VLOOKUPを利用したVBAを作成したい』（OPT）　ページの最後に飛ぶ