导出微信好友

gareth

有一篇好文章，可以一次性拷出微信好友到文本，见下文：
https://www.zhihu.com/question/36582391

我已经拷了出来到文本，有哪位老师可以写个代码将它再导出EXCEL，谢谢了！
如果能一步到位网页到EXCEL最好。
微信好友导出.zip (2.03 KB, 下载次数: 143)

2018-1-19 09:13 上传

点击文件名下载附件

kldxlb

正则匹配一下。或者纯粹的Split函数切分一下

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, n, filename, i, t
  filename = ThisWorkbook.Path & "\微信好友导出.txt"
  If Len(Dir(filename)) = 0 Then MsgBox "!": Exit Sub
  Open filename For Input As #1
  arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
  Close #1
  For i = 0 To UBound(arr)
    If InStr(arr(i), "user.getDisplayName()") Then
      t = Split(arr(i), "user.getDisplayName()")(1)
      t = Split(Split(t, "<")(0), ">")(1)
      arr(n) = t: n = n + 1
    End If
  Next
  With [a:a]
    .ClearContents
    If n > 0 Then .Resize(n, 1) = Application.Transpose(arr)
  End With
End Sub

zorsite

直接把源代码粘贴到Excel。
打开替换窗口，
查找内容输入：<*>
替换为留空
点击全部替换。

如果要写代码的话，录制一下宏：

Sub 宏1()
    Selection.Replace What:="<*>", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

zorsite

可以尝试下面的代码。

1. Sub 整理微信好友()
   
2. Application.ScreenUpdating = False
   
3. Dim arr
   
4. Dim i As Long
   
5.     arr = Sheets(1).[A1].CurrentRegion
   
6.     For i = UBound(arr) To 1 Step -1
   
7.         '删除不含名字的行
   
8.         If InStr(arr(i, 1), "nickname") = 0 Then Rows(i).Delete
   
9.     Next
   
10.     With Sheets(1).[A1].CurrentRegion
    
11.         '清理标签
    
12.         .Replace What:="<*>", Replacement:="", LookAt:=xlPart, _
    
13.             SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    
14.             ReplaceFormat:=False
    
15.         '删除空格
    
16.         .Replace What:="            ", Replacement:="", LookAt:=xlPart, _
    
17.             SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    
18.             ReplaceFormat:=False
    
19.     End With
    
20. Application.ScreenUpdating = True
    
21. End Sub

复制代码

gareth

zorsite 发表于 2018-1-20 10:50
可以尝试下面的代码。

多谢您的关注，谢谢！