不動產買賣查詢-Excel VBA

Excel VBA是一個很好用的程式設計工具,它的物件不外乎就是Application;Workbooks,Sheets 及Chart,利用巨集的方式執行副程式來達成數據的收集,篩選,分析等功能.這次是利用內政部不動產交易實價查詢服務網http://lvr.land.moi.gov.tw/來做"類大數據"分析的練習.

Sub selects()
 x = InputBox("請輸入關鍵字!!")
    For i = 2 To Sheets.Count '防止查詢已存在的名稱而產生錯誤
        If x = Sheets(i).Name Then
            MsgBox "工作表已存在請先刪除!!"
            Exit Sub
            'Application.DisplayAlerts = False '或者自動覆蓋更新
            'Sheets(i).Delete
            'Application.DisplayAlerts = True
            Exit For
        End If
    Next

    If x = "" Then '無填入訊息警示
        MsgBox "請務必輸入資料!!"
        Exit Sub
    End If

    Range("C1").Select '游標放C1

    selection.AutoFilter  '篩選
    r = Range("A1").End(xlDown).Row
    ActiveSheet.Range("$A$1:$L$" & r).AutoFilter Field:=3, Criteria1:="=*" & x & "*"

    If Range("A1").End(xlDown).Row = 65536 Then   '無結果
        MsgBox "查無資料!!"
        selection.AutoFilter
        Exit Sub
    End If

    Range("A1").Select  '複製
    Range(selection, selection.End(xlToRight)).Select
    Range(selection, selection.End(xlDown)).Select
    selection.Copy

    Sheets.Add After:=Sheets(Sheets.Count)  '新增工作表
    Sheets(Sheets.Count).Name = x

    Range("A1").Select  '貼上
    ActiveSheet.Paste

    selection.Columns.AutoFit  '自動調整欄寬

    Range("A1").Select

    Sheets(1).Select  '切回原工作表
    Application.CutCopyMode = False

    selection.AutoFilter '取消
    Range("A1").Select

End Sub

接著可到服務網去下載 lvr_landxls.zip套用測試了