Option Explicit
 
Public Sub 単語変換()
    Const OutColNo As Long = 26         '出力列番号 Z列
    Const OutColSize As Long = 10       '出力列数
    Dim ws1 As Worksheet    '単語帳
    Dim ws2 As Worksheet    'ししし
    Dim dicT As Object      'Dictionary キー：単語　値：置換単語
    Dim maxrow1 As Long
    Dim maxrow2 As Long
    Dim row1 As Long
    Dim row2 As Long
    Dim key As Variant
    Dim arr1 As Variant
    Dim arr2 As Variant
    Dim dicTkeys As Variant
    Dim str As String
    Dim i As Long
    Dim j As Long
    Dim out_ix As Long
    Dim t1 As Double
    Dim t2 As Double
    t1 = Timer
    Set ws1 = Worksheets("たたた")
    Set ws2 = Worksheets("ししし")
    Set dicT = CreateObject("Scripting.Dictionary")    ' Dictionaryの定義
    maxrow1 = ws1.Cells(Rows.count, "A").End(xlUp).row    'A列目の最終行を求める
    maxrow2 = ws2.Cells(Rows.count, "V").End(xlUp).row    'V列目の最終行を求める
    For row1 = 2 To maxrow1
        key = ws1.Cells(row1, "A").Value
        If key <> "" Then
            dicT(key) = ws1.Cells(row1, "E").Value
        End If
    Next
    arr1 = ws2.Range("V2:V" & maxrow2)
    ReDim arr2(1 To UBound(arr1, 1), 1 To OutColSize)
    For i = 1 To UBound(arr2, 1)
        For j = 1 To OutColSize
            arr2(i, j) = ""
        Next
    Next
    dicTkeys = dicT.keys
    For i = 1 To UBound(arr1, 1)
        str = arr1(i, 1)
        out_ix = 0
        If str <> "" Then
            For Each key In dicTkeys
                If InStr(1, str, key, vbBinaryCompare) > 0 Then
                    out_ix = out_ix + 1
                    If out_ix > OutColSize Then Exit For
                    arr2(i, out_ix) = dicT(key)
                End If
            Next
        End If
    Next
    ws2.Range(ws2.Cells(2, OutColNo), ws2.Cells(maxrow2, OutColNo + OutColSize - 1)).Value = arr2
    t2 = Timer
    MsgBox ("完了 " & t2 - t1 & "秒")
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOWNmOiqnuWkieaPmygpCiAgICBDb25zdCBPdXRDb2xObyBBcyBMb25nID0gMjYgICAgICAgICAn5Ye65Yqb5YiX55Wq5Y+3IFrliJcKICAgIENvbnN0IE91dENvbFNpemUgQXMgTG9uZyA9IDEwICAgICAgICflh7rlipvliJfmlbAKICAgIERpbSB3czEgQXMgV29ya3NoZWV0ICAgICfljZjoqp7luLMKICAgIERpbSB3czIgQXMgV29ya3NoZWV0ICAgICfjgZfjgZfjgZcKICAgIERpbSBkaWNUIEFzIE9iamVjdCAgICAgICdEaWN0aW9uYXJ5IOOCreODvO+8muWNmOiqnuOAgOWApO+8mue9ruaPm+WNmOiqngogICAgRGltIG1heHJvdzEgQXMgTG9uZwogICAgRGltIG1heHJvdzIgQXMgTG9uZwogICAgRGltIHJvdzEgQXMgTG9uZwogICAgRGltIHJvdzIgQXMgTG9uZwogICAgRGltIGtleSBBcyBWYXJpYW50CiAgICBEaW0gYXJyMSBBcyBWYXJpYW50CiAgICBEaW0gYXJyMiBBcyBWYXJpYW50CiAgICBEaW0gZGljVGtleXMgQXMgVmFyaWFudAogICAgRGltIHN0ciBBcyBTdHJpbmcKICAgIERpbSBpIEFzIExvbmcKICAgIERpbSBqIEFzIExvbmcKICAgIERpbSBvdXRfaXggQXMgTG9uZwogICAgRGltIHQxIEFzIERvdWJsZQogICAgRGltIHQyIEFzIERvdWJsZQogICAgdDEgPSBUaW1lcgogICAgU2V0IHdzMSA9IFdvcmtzaGVldHMoIuOBn+OBn+OBnyIpCiAgICBTZXQgd3MyID0gV29ya3NoZWV0cygi44GX44GX44GXIikKICAgIFNldCBkaWNUID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRGljdGlvbmFyeSIpICAgICcgRGljdGlvbmFyeeOBruWumue+qQogICAgbWF4cm93MSA9IHdzMS5DZWxscyhSb3dzLmNvdW50LCAiQSIpLkVuZCh4bFVwKS5yb3cgICAgJ0HliJfnm67jga7mnIDntYLooYzjgpLmsYLjgoHjgosKICAgIG1heHJvdzIgPSB3czIuQ2VsbHMoUm93cy5jb3VudCwgIlYiKS5FbmQoeGxVcCkucm93ICAgICdW5YiX55uu44Gu5pyA57WC6KGM44KS5rGC44KB44KLCiAgICBGb3Igcm93MSA9IDIgVG8gbWF4cm93MQogICAgICAgIGtleSA9IHdzMS5DZWxscyhyb3cxLCAiQSIpLlZhbHVlCiAgICAgICAgSWYga2V5IDw+ICIiIFRoZW4KICAgICAgICAgICAgZGljVChrZXkpID0gd3MxLkNlbGxzKHJvdzEsICJFIikuVmFsdWUKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgIGFycjEgPSB3czIuUmFuZ2UoIlYyOlYiICYgbWF4cm93MikKICAgIFJlRGltIGFycjIoMSBUbyBVQm91bmQoYXJyMSwgMSksIDEgVG8gT3V0Q29sU2l6ZSkKICAgIEZvciBpID0gMSBUbyBVQm91bmQoYXJyMiwgMSkKICAgICAgICBGb3IgaiA9IDEgVG8gT3V0Q29sU2l6ZQogICAgICAgICAgICBhcnIyKGksIGopID0gIiIKICAgICAgICBOZXh0CiAgICBOZXh0CiAgICBkaWNUa2V5cyA9IGRpY1Qua2V5cwogICAgRm9yIGkgPSAxIFRvIFVCb3VuZChhcnIxLCAxKQogICAgICAgIHN0ciA9IGFycjEoaSwgMSkKICAgICAgICBvdXRfaXggPSAwCiAgICAgICAgSWYgc3RyIDw+ICIiIFRoZW4KICAgICAgICAgICAgRm9yIEVhY2gga2V5IEluIGRpY1RrZXlzCiAgICAgICAgICAgICAgICBJZiBJblN0cigxLCBzdHIsIGtleSwgdmJCaW5hcnlDb21wYXJlKSA+IDAgVGhlbgogICAgICAgICAgICAgICAgICAgIG91dF9peCA9IG91dF9peCArIDEKICAgICAgICAgICAgICAgICAgICBJZiBvdXRfaXggPiBPdXRDb2xTaXplIFRoZW4gRXhpdCBGb3IKICAgICAgICAgICAgICAgICAgICBhcnIyKGksIG91dF9peCkgPSBkaWNUKGtleSkKICAgICAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICBOZXh0CiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICB3czIuUmFuZ2Uod3MyLkNlbGxzKDIsIE91dENvbE5vKSwgd3MyLkNlbGxzKG1heHJvdzIsIE91dENvbE5vICsgT3V0Q29sU2l6ZSAtIDEpKS5WYWx1ZSA9IGFycjIKICAgIHQyID0gVGltZXIKICAgIE1zZ0JveCAoIuWujOS6hiAiICYgdDIgLSB0MSAmICLnp5IiKQpFbmQgU3ViCg==