删除行和列并提取字符数字

cqyca

见附表，我想要达到第二张绿色部分的效果，如果第二张达不成，最起码要达成第一张绿色部分的效果。第二张图其实是把货物名称中的字符和汉字，以及数字和运算符都提取出来了。
因为对账单是对方传过来的，有时候格式不太一样，如，有时候货物名称在第10行，有时候在第9行，有时候货物名称后面有空列，有时候没有，但是，要变成我的格式，是有一定规律的，共同点如下：
1、A列有“合计”字样的，“合计”和“合计”以下的行全部删除。
2、“货物名称”上面的行全部删除。
3、“货物名称”后面若有空列，全部删除。
4、“金额”列后面的列全部删除。
5、“货物名称”前面的列全部删除。 求助.rar (29.19 KB, 下载次数: 15)

2014-1-22 09:49 上传

点击文件名下载附件

homebaby2013

亲亲，欢迎加入excel交流群 116925631，拜托生活工作学习中需要使用excel的朋友加入，给个人气啊

戒不掉心中的瘾

新手练手，不保证质量，请注意保存好副本。

雪舞子

1. Sub 提取()
   
2.     Dim arr, brr(), i%, j%, k1%, k2%, n1%, n2%, e1%, e2%
   
3.     Dim reg As Object, zz, z
   
4.     Set reg = CreateObject("vbscript.regexp")
   
5.     arr = Sheets(1).Range("d9").CurrentRegion.Value
   
6.     ReDim brr(1 To UBound(arr), 1 To 6)
   
7.     For i = 1 To UBound(arr)
   
8.         For j = 1 To UBound(arr, 2)
   
9.             If arr(i, j) = "货物名称" Then n1 = i: n2 = j
   
10.             If arr(i, j) = "合计" Then e1 = i
    
11.             If arr(i, j) = "金额" Then e2 = j
    
12.         Next
    
13.     Next
    
14.     For i = n1 To e1 - 1
    
15.         k2 = 1: k1 = k1 + 1
    
16.         For j = n2 To e2
    
17.             If arr(i, j) <> "" Then
    
18.                 k2 = k2 + 1
    
19.                 brr(k1, k2) = arr(i, j)
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     With reg
    
24.         .Global = True
    
25.         .Pattern = "(.+[\u4e00-\u9fa5]+)(.+)"
    
26.         For i = 2 To UBound(brr)
    
27.             Set zz = .Execute(brr(i, 2))
    
28. 
    
29.             For Each z In zz
    
30.                 brr(i, 1) = .Replace(z.Value, "$1")
    
31.                 brr(i, 2) = .Replace(z.Value, "$2")
    
32.             Next
    
33.         Next
    
34.     End With
    
35.     Range("a1").CurrentRegion.ClearContents
    
36.     Sheets(3).Range("a1").Resize(k1, 6) = brr
    
37.     Sheets(3).Range("a1").Resize(1, 2) = Array("货物名称", "规格型号")
    
38.     MsgBox "提取完毕", , "提示"
    
39. End Sub

复制代码

求助.rar (38.41 KB, 下载次数: 4)

2014-1-22 12:36 上传

点击文件名下载附件

cqyca

谢谢大家