excel数据分条发QQ或微信消息

wujie632

众知一条微信最多发送2048个字符，QQ最多发送4500个字符，多的要分条发送，

还有Excel复制的数据直接粘贴到QQ或微信时是图片格式发送，要粘贴到记事本再全选复制，才可以在微信或QQ上粘贴成文字字符发送

在网页复制的文字有大量的双换行、假换行和软换行

我编个在word上使用VBa代码就是解决这3个问题，仅供参考

这里是以手机号为例，每行一个的手机号（11个数字）为一段

1. Sub 微信消息分拆()
   
2. Selection.WholeStory
   
3. Selection.Font.Size = 10
   
4. Selection.Copy
   
5. Selection.PasteAndFormat (wdFormatPlainText) '全选复制选择性粘贴为无格式文本，即去表格
   
6. 
   
7. ActiveDocument.Content.Find.Execute FindText:="^l", replacewith:="", Replace:=wdReplaceAll '全部替换软回车符
   
8. ActiveDocument.Content.Find.Execute FindText:="^l3", replacewith:="", Replace:=wdReplaceAll '全部替换假回车符
   
9. ActiveDocument.Content.Find.Execute FindText:="^p^p", replacewith:="^p", Replace:=wdReplaceAll '全部替换双行
   
10. 
    
11. zhs = ActiveDocument.Paragraphs.Count '微信一条最多发送2048个字符
    
12. Do While hs < zhs
    
13.   If zhs > hs + 186 Then
    
14.     ActiveDocument.Range(ActiveDocument.Paragraphs(1).Range.Start, ActiveDocument.Paragraphs(186).Range.End).Cut 'Select
    
15.     hs = hs + 186
    
16.     n = n + 1
    
17.     MsgBox "第" & n & "次剪切186个号码，累计" & hs & " 个号码，剩余" & zhs - hs & Chr(10) & "先粘贴到微信，再确认自动剪切下186条"
    
18.   Else
    
19.     Selection.WholeStory
    
20.     Selection.Cut
    
21.     hs = hs + 186
    
22.     n = n + 1
    
23. 
    
24.     MsgBox "第" & n & "次剪切(最后一次）" & zhs - hs + 186 & "个号码，累计" & zhs & " 个号码" & Chr(10) & "先粘贴到微信，再确认结束"
    
25.   End If
    
26. Loop
    
27. End Sub
    

复制代码

wujie632

1. Sub 分拆QQ消息()
   
2. Selection.WholeStory
   
3. Selection.Font.Size = 10
   
4. Selection.Copy
   
5. Selection.PasteAndFormat (wdFormatPlainText) '全选复制选择性粘贴为无格式文本，即去表格
   
6. 
   
7. ActiveDocument.Content.Find.Execute FindText:="^l", replacewith:="", Replace:=wdReplaceAll '全部替换软回车符
   
8. ActiveDocument.Content.Find.Execute FindText:="^l3", replacewith:="", Replace:=wdReplaceAll '全部替换假回车符
   
9. ActiveDocument.Content.Find.Execute FindText:="^p^p", replacewith:="^p", Replace:=wdReplaceAll '全部替换双行
   
10. 
    
11. zhs = ActiveDocument.Paragraphs.Count 'QQ一条最多发送4500个字符
    
12. Do While hs < zhs
    
13.   If zhs > hs + 409 Then
    
14.     ActiveDocument.Range(ActiveDocument.Paragraphs(1).Range.Start, ActiveDocument.Paragraphs(409).Range.End).Cut 'Select
    
15.     hs = hs + 409
    
16.     n = n + 1
    
17.     MsgBox "第" & n & "次剪切409个号码，累计" & hs & " 个号码，剩余" & zhs - hs & Chr(10) & "先粘贴到QQ等，再确认剪切下409条"
    
18.   Else
    
19.     Selection.WholeStory
    
20.     Selection.Cut
    
21.     hs = hs + 409
    
22.     n = n + 1
    
23. 
    
24.     MsgBox "第" & n & "次剪切(最后一次）" & zhs - hs + 409 & "个号码，累计" & zhs & " 个号码" & Chr(10) & "先粘贴到QQ等，再确认结束"
    
25.   End If
    
26. Loop
    
27. End Sub

复制代码