Excel VBA应用

以上这个问题，解决方案如下：

按Alt+F11快捷键，进入VB编辑器，插入[模块1]，在其代码窗口中，输入如下代码：

Sub Iphone(rng)

Dim getpage As String, TelNumber As String

TelNumber = Replace(Replace(rng.Value, "-", ""), "+86", "")

With CreateObject("Microsoft.XMLHTTP")

.Open "get", "http://www.ip138.com:8080/search.asp?action=mobile&mobile=" & TelNumber, False

.send

getpage = StrConv(.responseBody, vbUnicode, &H804)

getpage = Split(Split(getpage, "卡号归属地</TD>")(1), " <a href=")(0)

Dim DiQu As String, Ka As String, arr(1 To 1, 1 To 3)

DiQu = Split(getpage, "</TD>")(0)

DiQu = Split(DiQu, ">")(UBound(Split(DiQu, ">")))

arr(1, 1) = Split(DiQu, " ")(0)

arr(1, 2) = Split(DiQu, " ")(1)

Ka = Split(Split(getpage, "卡 类 型</")(1), "</TD>")(0)

arr(1, 3) = Split(Ka, ">")(UBound(Split(Ka, ">")))

rng.Offset(0, 1).Resize(1, 3) = arr

End With

End Sub

Sub 获取信息()

Dim rng As Range

If TypeName(Selection) <> "Range" Then Exit Sub

If Intersect(ActiveSheet.UsedRange, Selection) Is Nothing Then MsgBox "请选择您要查询的手机号码，再执行该过程！": Exit Sub

With Selection

If .Columns.Count > 1 Then MsgBox "只能选择一列的区域！", vbOKOnly, "提示": Exit Sub

If .Row = 1 Then MsgBox "请不要选择标题行！", vbOKOnly, "提示": Exit Sub

For Each rng In .Cells

If Len(rng) > 10 Then Call Iphone(rng)

Next rng

.CurrentRegion.Borders.LineStyle = xlContinuous

.Cells(1).Offset(-1, 1).Resize(1, 3) = Array("省份", "归属地", "卡类型")

End With

[模块1]代码截图如下：

最后，选择查询的手机号码区域，把光标定位在代码任意位置，按[执行]按钮，效果如下：

神奇，简单吧！喜欢就点赞，评论，分享哦！！