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
vba+正则处理千牛订单
最后编辑于 :
©著作权归作者所有,转载或内容合作请联系作者
- 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
- 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
- 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...