ExcelSuggestのソース　http://deltam.blogspot.com/2005/03/avexexcel-suggest.html

excelsuggest.vba

Option Explicit

Private lastKeyword As String

Sub macro1()
    MsgBox "iii spase !!!"
    
End Sub


Sub suggest()
    Dim keyword As String
    Dim list As String
    Dim words() As String
    Dim max As Integer
    Dim i As Integer
    Dim keyV As Integer
    Dim keyH As Integer
    Dim resultV As Integer
    Dim resultH As Integer
    
    keyV = 8
    keyH = 4
    resultV = 8
    resultH = 4
    
    ' 画面のちらつきを防ぐ
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Worksheets(1)
        keyword = .Cells(keyV, keyH).Value
        
        If keyword = lastKeyword Then
            Exit Sub
        End If
        
        list = getWordList(keyword)
        '.Worksheets(1).Cells(10, 5).Value = list
    
        Open ("C:¥TEMP¥wordList.txt") For Output As #1
        Print #1, list
        Close #1
        
    
        words = getWordArray(list)
        max = UBound(words)
        For i = 1 To max
            .Cells(resultV + i, resultH).Value = words(i, 1)
            .Cells(resultV + i, resultH + 1).Value = words(i, 2)
            .Cells(resultV + i, resultH + 1).Font.Color = RGB(0, 200, 40)
            .Cells(resultV + i, resultH + 1).Select
            With Selection
               .HorizontalAlignment = xlRight
            End With
            
            .Cells(resultV + i, resultH).Font.Size = 9
            .Cells(resultV + i, resultH + 1).Font.Size = 9
            
            '.Cells(i + 1, 1).EntireColumn.AutoFit
            '.Cells(i + 1, 2).EntireColumn.AutoFit
           
        Next i
        
        .Cells(keyV, keyH).Select
        
    End With
    
    lastKeyword = keyword
    
    Application.ScreenUpdating = True

End Sub


Function getWordList(keyword As String) As String
    Dim xhttp As Object
    Dim list As String
    Dim query As String
    
    'query = "http://www.google.com/complete/search?hl=en&js=true&qu="
    query = "http://www.google.com/complete/search?hl=en&js=true&qu="
    query = query & keyword
    
    Set xhttp = CreateObject("MSXML2.XMLHTTP")
    If Err.Number <> 0 Then
        Set xhttp = CreateObject("MSXML.XMLHTTPRequest")
    End If
    
    xhttp.Open "GET", query, False
    xhttp.send
    
    getWordList = xhttp.responseText
    
End Function


Function getWordArray(list As String)
    Dim titles() As String
    Dim temp1() As String
    Dim temp2() As String
    Dim result(10, 2) As String
    Dim max As Integer
    Dim i As Integer
    
    list = Replace(list, "),", "")
    titles = Split(list, "new Array(")
    temp1 = Split(titles(1), """,")
    temp2 = Split(titles(2), """,")
    
    max = UBound(temp1)
    For i = 1 To max
        result(i, 1) = Replace(temp1(i), """", "")
        result(i, 2) = Replace(temp2(i), """", "")
    Next i
    
    getWordArray = result

End Function

ExcelSuggest.xls