https://tj.zu.anjuke.com/fangyuan/hebei/p2/

Sub 安居客租房数据升级版()On Error Resume NextDim arr(), drr()brr = Array("hebei")'这里仅仅获取河北区的租房信息，也可扩展填入其他区的拼音。Range("a1").Resize(1, 14) = Array("Community_name", "Price", "Layout", "area", "Direction", "Floor", " decoration ", "house_type", "House_code", "release_time", "rent_type", "rent_type2", "url", "district")Set XML = CreateObject("msxml2.xmlhttp")ActiveSheet.Range("a2:z10000").ClearFor m = 0 To UBound(brr)For Page = 1 To 1XML.Open "get", "https://tj.zu.anjuke.com/fangyuan/" & brr(m) & "/p" & Page & "/", False '打开网页XML.send    '发送请求Do While XML.ReadyState <> 4 '等待请求DoEventsLoopstrText = XML.responseText '获取返回数据Set reg = CreateObject("vbscript.regexp")reg.Global = Truereg.IgnoreCase = Truereg.MultiLine = Truereg.Pattern = " href=""(https://tj.zu.anjuke.com/fangyuan/d{10}?isauction=2&shangquan_id=d+)" '单个房源地址For Each mat In reg.Execute(strText)k = k + 1ReDim Preserve arr(1 To k)arr(k) = mat.SubMatches(0)ReDim Preserve drr(1 To k)drr(k) = brr(m)NextNextNextReDim crr(1 To UBound(arr), 1 To 12) '定义存储租房具体信息的数组For num = 1 To UBound(arr)XML.Open "get", arr(num), False '打开网页XML.send    '发送请求Do While XML.ReadyState <> 4 '等待请求DoEventsLoopreg.Pattern = "s+"result = reg.Replace(XML.responseText, "")crr(num, 1) = Split(Split(result, """propview"">")(1), "<")(0)crr(num, 2) = Split(Split(result, "price""><em>")(1), "<")(0)crr(num, 3) = Split(Split(result, "户型：</span><spanclass=""info"">")(1), "<")(0)crr(num, 4) = Split(Split(result, "面积：</span><spanclass=""info"">")(1), "<")(0)crr(num, 5) = Split(Split(result, "朝向：</span><spanclass=""info"">")(1), "<")(0)crr(num, 6) = Split(Split(result, "楼层：</span><spanclass=""info"">")(1), "<")(0)crr(num, 7) = Split(Split(result, "装修：</span><spanclass=""info"">")(1), "<")(0)crr(num, 8) = Split(Split(result, "类型：</span><spanclass=""info"">")(1), "<")(0)crr(num, 9) = "'" & Split(Split(result, "房屋编码：")(1), "，")(0)crr(num, 10) = Split(Split(result, "发布时间：")(1), "<")(0)crr(num, 11) = Split(Split(result, "元/月</span><spanclass=""type"">")(1), "<")(0)crr(num, 12) = Split(Split(result, "<liclass=""title-label-itemrent"">")(1), "<")(0)NextActiveSheet.Range("a2").Resize(UBound(crr), 12) = crrActiveSheet.Range("m2").Resize(UBound(arr), 1) = Application.Transpose(arr)ActiveSheet.Range("n2").Resize(UBound(arr), 1) = Application.Transpose(drr)Columns.AutoFit
End Sub