[已解决]有那位高手可以帮帮忙用宏实现该操作呢（急，在线等候）

qijia0311

供应商：广州GN12仓,  配送物流：申通快递,  颜色：图片色,  款号：GN120559,  尺码：27：标准码,  收货人：刘红梅,  手机：13580989772,  固话：联系电话,  地址：广东省东莞市寮步镇广东省 东莞市 广东省东莞市寮步华南工业园铨讯电子有限公司,  备注：,
怎么用宏提取 里面的 快递 省份只需前面的两个子，详情请看附件
根据 快递类型，和省份进行，快递费用的筛选，


附件已经上传   求助.zip (11.18 KB, 下载次数: 25)

2012-8-7 14:42 上传

点击文件名下载附件
在线等待

最佳答案

月排行榜 / 总排行榜

JLxiangwei

2012-8-7 15:34

1. Sub test()
   
2.     Dim x
   
3.     For x = 2 To 12
   
4.       Cells(x, 3) = Application.WorksheetFunction.Substitute(Left(Split(Cells(x, 1), "配送物流：")(1), 4), ",", "")
   
5.       Cells(x, 4) = Left(Split(Cells(x, 1), "地址：")(1), 2)
   
6.     Next
   
7. End Sub
   

复制代码

不是很完美的解决方法，但是也可解决了

跳转到最佳答案楼层

JLxiangwei

1. Sub test()
   
2.     Dim x
   
3.     For x = 2 To 12
   
4.       Cells(x, 3) = Application.WorksheetFunction.Substitute(Left(Split(Cells(x, 1), "配送物流：")(1), 4), ",", "")
   
5.       Cells(x, 4) = Left(Split(Cells(x, 1), "地址：")(1), 2)
   
6.     Next
   
7. End Sub
   

复制代码

不是很完美的解决方法，但是也可解决了

qijia0311

If Range("d" & X) = "wrzs-311" Then
Range("n" & X) = 20
如果我是WRZS-002 也是等于20
怎么在地一条公式上面加上去呢

hrpotter

1. Sub test()
   
2.     Dim arr
   
3.     Dim d As Object
   
4.     Dim i As Long, j As Long
   
5.     Dim s1, s2
   
6.     Application.ScreenUpdating = False
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     For j = 9 To 12 Step 3
   
9.         s1 = Cells(1, j).Value
   
10.         For i = 3 To 33
    
11.             If Cells(i, j + 1) > 0 Then
    
12.                 s2 = Cells(i, j + 1)
    
13.             End If
    
14.             d(s1 & Cells(i, j).Value) = s2
    
15.         Next
    
16.     Next
    
17.     arr = Range("i3:i33")
    
18.     For i = 1 To UBound(arr)
    
19.         d("EMS" & arr(i, 1)) = 20
    
20.     Next
    
21.     For i = 2 To Range("a1").CurrentRegion.Rows.Count
    
22.         For j = 1 To UBound(arr)
    
23.             If Cells(i, 1) Like "*" & arr(j, 1) & "*" Then
    
24.                 Cells(i, 4) = arr(j, 1)
    
25.                 If Cells(i, 1) Like "*圆通*" Then
    
26.                     Cells(i, 3) = "圆通"
    
27.                 ElseIf Cells(i, 1) Like "*申通*" Then
    
28.                     Cells(i, 3) = "申通"
    
29.                 Else
    
30.                     Cells(i, 3) = "EMS"
    
31.                 End If
    
32.                 Cells(i, 2) = d(Cells(i, 3).Value & Cells(i, 4).Value)
    
33.             End If
    
34.         Next
    
35.     Next
    
36.     Application.ScreenUpdating = True
    
37. End Sub

复制代码