又一个宏,这次是关于查询的

2016年2月3日13:51:53 发表评论 1

马上春节了,事情不多,今天上午又帮人做了一个查询的宏。
源文件是个极其不规范的表格,里面在数据源中存在很多合并单元格,数据也并非都在一列中,好在每个数据区域还算比较有规律(有固定的行、列数量),索引关键字在每个数据区域内的相对位置也是固定的。
代码的思路是遍历数据源表的单元格,当出现索引关键词的时候,将特定位置的数据录入到查询表中。很简单的一个小功能。这段代码中首次使用了“like”,所以在此记录一下。
PS:这个宏的需求者电脑上安装的是精简版office2003,没有VBA功能。。。让我伤心了好久……

Attribute VB_Name = "查询指定客户订单及产品"
Sub 查询()
Dim MB As String
MB = InputBox(prompt:="您要在哪个sheet中进行查询?", Default:="清单")
Worksheets("查询").Rows("3:65536").Select
Selection.Delete Shift:=xlUp
Dim HH, LH, NH, CX As Integer
For HH = 2 To 439
For LH = 2 To 214
If Worksheets("查询").Cells(1, 2).Formula Like Worksheets(MB).Cells(HH, LH).Formula Then
For NH = 2 To 16
If Worksheets(MB).Cells(HH, LH).Offset(NH, -1) <> "" Then
CX = Application.CountA(Worksheets("查询").Range("A:A"))
CX = CX + 1
Worksheets("查询").Range("A" & CX) = Worksheets(MB).Cells(HH, LH).Offset(rowOffset:=NH, columnOffset:=-1)
Worksheets("查询").Range("B" & CX) = Worksheets(MB).Cells(HH, LH).Offset(rowOffset:=NH, columnOffset:=0)
Worksheets("查询").Range("C" & CX) = Worksheets(MB).Cells(HH, LH).Offset(rowOffset:=NH, columnOffset:=1)
Worksheets("查询").Range("D" & CX) = Worksheets(MB).Cells(HH, LH).Offset(rowOffset:=NH, columnOffset:=2)
Worksheets("查询").Range("E" & CX) = Worksheets(MB).Cells(HH, LH).Offset(rowOffset:=NH, columnOffset:=3)
Worksheets("查询").Range("F" & CX) = Worksheets(MB).Cells(HH, LH).Offset(rowOffset:=0, columnOffset:=1)
End If
Next NH
NH = 1
End If
Next LH
Next HH
Worksheets("查询").Range("B1").

Select
End Sub

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: