Excel 即時查詢口罩

snare wrote:
縣市篩選功能，或某縣市有貨提示功能(恕刪)

kmo_tw wrote:
這個EXCEL就有篩選功能，地址欄位篩選 "XX市XX區" ，成人或兒童口罩數量大於0
基本上篩選後會發現該區剩沒幾家藥局可以買的(恕刪)

'篩選方式，在c1，填入條件
'例如：台北市北投區
'c1 可填入=>台北 投=>臺 北 投=>北投
'注意一：不同條件，用空格隔開
'注意二：條件需照順序(地址寫法)，縣=>市=>區=>路=>號 …，例如"路"不可以在"市"前面，但可跳著寫


Sub Main()

    Dim Xmlhttp As Object, Clipboard As Object, URL As String
    Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set Xmlhttp = CreateObject("Msxml2.XMLHTTP")
    
    URL = "https://data.nhi.gov.tw/resource/mask/maskdata.csv"
    On Error Resume Next
    
    Xmlhttp.Open "GET", URL, False
    Xmlhttp.send
    
    Clipboard.SetText Xmlhttp.responsetext
    Clipboard.PutInClipboard

    With Sheets("工作表1")
        .Select
        .Range("$C$3").AutoFilter
        .Rows("2:" & .Rows.Count).ClearContents
        .Cells(2, 1).Select
        .PasteSpecial NoHTMLFormatting:=True
        Selection.TextToColumns DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True
        .Columns.AutoFit
        
        Call Find_mask
        
        .Cells(1, 1).Select
    End With
    
    Set Xmlhttp = Nothing
    Set Clipboard = Nothing
    
End Sub

Sub Find_mask()
    
    Dim Location As Variant, Criteria_1 As String, Criteria_2 As String
    On Error Resume Next

    With Sheets("工作表1")
        If Not IsEmpty(.Range("c1")) Then
            Application.ScreenUpdating = False

            Criteria_1 = "*" & Replace(.Range("c1"), " ", "*") & "*"

            If InStr(Criteria_1, "台") > 0 Or InStr(Criteria_1, "臺") > 0 Then
                If InStr(Criteria_1, "台") > 0 Then Criteria_2 = Replace(Criteria_1, "台", "臺")
                If InStr(Criteria_1, "臺") > 0 Then Criteria_2 = Replace(Criteria_1, "臺", "台")
                Location = Array(Criteria_1, Criteria_2)
            Else
                Location = Criteria_1
            End If
            .Range("$C$3").AutoFilter
            .Range("$C$3").AutoFilter Field:=3, Criteria1:=Location, Operator:=xlFilterValues
            Application.ScreenUpdating = True

        End If
    End With

End Sub

snare wrote:
現在手機口罩查詢app(恕刪)

michael1977 wrote:
健保局撈出來的資料五(恕刪)