文本性信息按规则自动生成信息流水

lizhuo_7

各位大神，我公司现实情况是业务员报货在微信里，量比较大，内勤人员需要在微信群里复制报货的信息，在用手工敲到excel表里，如何能把微信的端信息复制到excel的固定位置后，按照规则自动生成标准的数字格式。另外，不知道有没有哪位大神有兴趣为我公司提供技术服务，可以私聊。感谢，感谢。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr(1 To 10000, 1 To 7)
   
4.   With Worksheets("西固红霞鲜肉店")
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
   
6.     arr = .Range("a1:a" & r)
   
7.   End With
   
8.   m = 0
   
9.   For i = 1 To UBound(arr)
   
10.     If Len(arr(i, 1)) <> 0 Then
    
11.       xm = Split(arr(i, 1), vbLf)
    
12.       khmc = Split(xm(0), "：")(1)
    
13.       chmd = Split(xm(1), "：")(1)
    
14.       ywy = Split(xm(2), "：")(1)
    
15.       rq = Split(xm(3), "：")(1)
    
16.       For j = 5 To UBound(xm)
    
17.         xm1 = Split(xm(j), "/")
    
18.         m = m + 1
    
19.         brr(m, 1) = khmc
    
20.         brr(m, 2) = chmd
    
21.         brr(m, 3) = ywy
    
22.         brr(m, 4) = rq
    
23.         brr(m, 5) = xm1(0)
    
24.         brr(m, 6) = xm1(1)
    
25.         brr(m, 7) = xm1(2)
    
26.       Next
    
27.     End If
    
28.   Next
    
29.   With Worksheets("sheet1")
    
30.     .UsedRange.Offset(1, 0).Clear
    
31.     .Range("a2").Resize(m, UBound(brr, 2)) = brr
    
32.   End With
    
33. End Sub
    

复制代码

chxw68

如果微信信息不规范这个代码就用不成。

老骥705664849

是不是所有的信息都是目前A1单元格的样式，如果都是这个样式的话，好办

lizhuo_7

老骥705664849 发表于 2020-7-6 10:18
是不是所有的信息都是目前A1单元格的样式，如果都是这个样式的话，好办

是的，我们会规范文本的格式

老骥705664849

Sub 整理()
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:a" & r)
    Dim arr()
    ReDim arr(1 To 100000, 1 To 7)
    For i = 1 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            If InStr(ar(i, 1), Chr(10)) > 0 Then
                rr = Split(ar(i, 1), Chr(10))
                For s = 5 To UBound(rr)
                    n = n + 1
                    arr(n, 1) = Split(rr(0), "：")(1)
                    arr(n, 2) = Split(rr(1), "：")(1)
                    arr(n, 3) = Split(rr(2), "：")(1)
                    arr(n, 4) = Split(rr(3), "：")(1)
                    vr = Split(rr(s), "/")
                    arr(n, 5) = vr(0)
                    arr(n, 6) = vr(1)
                    arr(n, 7) = vr(2)
                Next s
            End If
        End If
    Next i
End With
With Sheets("结果")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(n, UBound(arr, 2)) = arr
End With
End Sub

老骥705664849

代码近针对你上传的附件，仅供参考
求助.rar (16.77 KB, 下载次数: 2)

2020-7-6 10:31 上传

点击文件名下载附件

zpy2

如果业务量比较多，可能需要自己搞个类似在线报单系统。