kmo_tw wrote:
這個EXCEL就有篩選功能，地址欄位篩選 "XX市XX區" ，成人或兒童口罩數量大於0
基本上篩選後會發現該區剩沒幾家藥局可以買的(恕刪)
現在手機口罩查詢app、各大網站的口罩地圖，都很好用
如果真要使用vba，那就代表使用者是用
桌上型=>固定地點 or 筆電=>固定 或 暫時停留
要買當然是找附近買
因為資料6千多筆，加上還有同音字的問題(臺=台)
所以才會建議加上vba篩選功能，而不是人工篩選
(不是每個人都會多條件篩選)
寫一個簡易多條件篩選功能，請參考
'篩選方式，在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
[點擊下載]
