vba+正则处理千牛订单

原始数据

处理后

Sub totanbao()

Dim mycolumns '表示某一列的行数

Dim name As String, tel As String, address As String, goodsname As String, digit As String
'客户姓名 电话 地址 物品名 物品数量

Dim count As Integer, title, State As String, leaveword As String
'表示有多少列 表头的内容 订单的状态 客户留言

Dim recvAddress As String, k As Integer
'获取的地址 数组的下标

Dim arr(), j As Integer
'数组 存放地址正则后的省市区 下标

mycolumns = [A65536].End(xlUp).Row
'A这一列的行数

title = Array("收件人姓名", "收件人手机号码", "收件人固定电话", "收件人省", "收件人市", "收件人区", "收件人详细地址", "邮编", "卖家备注", "交易时间", "订单金额", "支付金额", "交易备注", "买家留言")

j = 2

'''''''''''''''''''
'''''''设置表头内容
    For count = 1 To 14
    
    Sheets("淘宝").Cells(1, count).Value = title(count - 1)
    
    If (count = 1) Then
    
    Sheets("淘宝").Cells(1, count).Interior.Color = RGB(255, 0, 0)
    
    ElseIf (count > 1 And count < 8) Then
    
    Sheets("淘宝").Cells(1, count).Interior.Color = RGB(255, 255, 0)
    
    End If
    
    Next
'''''''''''''''''''
'''''''''''''''''''

    For i = 2 To mycolumns '循环从第一行到最后有效的最后一行
    
    name = Range("M" & i) '得到目前收货人姓名
    
    address = Range("N" & i) ' 得到目前的收货人地址
    
    tel = Range("Q" & i) '得到收货人电话
    
    goodsname = Range("T" & i) ' 得到商品标题
    
    leaveword = Range("L" & i) '得到留言
    
    digit = Range("U" & i) '得到商品的数量
    
    State = Range("K" & i) ' 得到订单状态


    If (State = "买家已付款，等待卖家发货" And goodsname = "【探极】芬兰 Xyliderm 雪丽泽 木糖醇凝露 湿疹敏感肌修护无激素") Then
    
    Sheets("淘宝").Range("A" & j) = name
    
    Sheets("淘宝").Range("B" & j) = tel
    
    
    Sheets("淘宝").Range("G" & j) = address
    
    
    Sheets("淘宝").Range("M" & j) = ("雪丽泽100ml" + "*" + digit)
        If (leaveword = "null") Then
            Sheets("淘宝").Range("N" & j) = ""
        ElseIf (leaveword <> "null") Then
            Sheets("淘宝").Range("N" & j) = leaveword
        End If
    
    
    
    recvAddress = Sheets("淘宝").Range("G" & j)
    ''''正则处理
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[\u4e00-\u9fa5]{2,10}\s+" '中文+第一个空格
        
        Set telsum = .Execute(recvAddress)
        '对地址进行切割
        '切割三次获取省市区就可以
        ReDim arr(0 To 2)
        k = 0
        For Each namedigit In telsum
            arr(k) = namedigit
            'MsgBox arr(k)
            k = k + 1
            If (k >= 3) Then
                Exit For
            End If
        Next
        recvAddress = .Replace(recvAddress, "")
        Sheets("淘宝").Range("G" & j) = recvAddress
        Sheets("淘宝").Range("D" & j) = arr(0)
        Sheets("淘宝").Range("E" & j) = arr(1)
        Sheets("淘宝").Range("F" & j) = arr(2)
    
    End With
    End If
    '''''
    j = j + 1
    Next
End Sub