求助，能不能做一个根据身份证提取省市县的表格

可以做到

虽然我的办法有点笨，可以把身份证分列，然后用前段去 vlookup ，就能提取到

可以匹配

Option Explicit
Sub abc()
　Dim url As String, getpage, t, i, m, a
　url = "http://www.tcmap.com.cn/list/daima_list.html"
　With CreateObject("Microsoft.XMLHTTP")
　　.Open "GET", url, False
　　.Send
　　getpage = .ResponseBody
　End With
　With CreateObject("adodb.stream")
　　.Type = 1
　　.Mode = 3
　　.Open
　　.Write getpage
　　.Position = 0
　　.Type = 2
　　.Charset = "GB2312"
　　a = Split(.ReadText, "<br>")
　End With
　ReDim b(1 To UBound(a), 1 To 2)
　For i = 1 To UBound(a)
　　If InStr(a(i), "0000") = 0 Then
　　　a(i) = Trim(a(i))
　　　If IsNumeric(Left(a(i), 6)) Then
　　　　t = Split(a(i), "target=_blank>")
　　　　If InStr(t(1), "<") Then
　　　　　m = m + 1
　　　　　b(m, 1) = Left(a(i), 6)
　　　　　b(m, 2) = Split(t(1), "<")(0)
　　　　End If
　　　End If
　　End If
　Next
　[a1].Resize(m, 2) = b
End Sub