楼主
xmyjk |
Q:如何运用VBA制作福建省增值税票查询工具?
A:- Option Explicit
- Sub test()
- Dim tmp() As String, i As Integer, arr() As String, xmlhttp As Object, N As Long, T, P&
- Dim FPDM, FPHM, DJH, J%, FD As String, FH As String, DJ As String, url As String
- FPDM = Range([A1], [A65536].End(3)).Value
- FPHM = Range([B1], [B65536].End(3)).Value
- DJH = Range([C1], [C65536].End(3)).Value
- P = ([A65536].End(xlUp).Row - 2) \ 10 + 1
- Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
- For N = 1 To P
- If N <> P Then
- FD = FPDM((N - 1) * 10 + 2, 1)
- FH = FPHM((N - 1) * 10 + 2, 1)
- DJ = DJH((N - 1) * 10 + 2, 1)
- For J = 2 To 10
- FD = FD & ";" & FPDM((N - 1) * 10 + J + 1, 1)
- FH = FH & ";" & FPHM((N - 1) * 10 + J + 1, 1)
- DJ = DJ & ";" & DJH((N - 1) * 10 + J + 1, 1)
- Next
- Else
- FD = FPDM((N - 1) * 10 + 2, 1)
- FH = FPHM((N - 1) * 10 + 2, 1)
- DJ = DJH((N - 1) * 10 + 2, 1)
- If (UBound(FPDM) - 2) Mod 10 + 1 > 1 Then
- For J = 2 To (UBound(FPDM) - 2) Mod 10 + 1
- FD = FD & ";" & FPDM((N - 1) * 10 + J + 1, 1)
- FH = FH & ";" & FPHM((N - 1) * 10 + J + 1, 1)
- DJ = DJ & ";" & DJH((N - 1) * 10 + J + 1, 1)
- Next
- End If
- End If
- url = "http://www.fj-n-tax.gov.cn/wssw/jsp/common/query/fpcy02.jsp?fpdm=" & FD & "&fphm=" & FH & "&xfswdjh=" & DJ
- FD = "": FH = "": DJ = ""
- With xmlhttp
- .Open "get", url, False
- .send
- tmp = Filter(Split(Replace(Replace(.responsetext, "blue-td-title", ""), " ", ""), "</td>"), "class=""blue-td")
- End With
- url = ""
- ReDim arr(UBound(tmp) \ 6, 5)
- For i = 0 To UBound(tmp)
- T = Split(tmp(i), ">")
- arr(i \ 6, i Mod 6) = T(UBound(T))
- Erase T
- Next
- Cells((N - 1) * 10 + 2, 5).Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
-
- Erase tmp, arr
- Next
- [a:J].Columns.AutoFit
- Erase FPDM, FPHM, DJH
- Set xmlhttp = Nothing
-
- MsgBox "Ok"
- End Sub
 福建省增值税票查询工具.zip
|