|
发表于 2016-12-14 09:54
|
显示全部楼层
本楼为最佳答案
在“客户信息表”里点击按钮。
- Sub 生成客户信息表()
- Dim sh As Worksheet, wb As Workbook
- Set d = CreateObject("scripting.dictionary")
- arr = [a1].CurrentRegion
- For i = 2 To UBound(arr)
- d(arr(i, 2)) = d(arr(i, 2)) & "," & i
- Next
- Set wb = Workbooks.Open(ThisWorkbook.Path & "\顾客信息.xls")
- Set sh = wb.Worksheets(1)
- For Each x In d.keys
- sh.Activate
- sh.Copy
- xrr = Split(d(x), ",")
- With ActiveSheet
- .[c4] = arr(xrr(1), 1)
- .[c5] = arr(xrr(1), 2)
- ReDim brr(1 To UBound(xrr), 3 To UBound(arr, 2))
- For i = 1 To UBound(xrr)
- For j = 3 To UBound(arr, 2)
- brr(i, j) = arr(xrr(i), j)
- Next
- Next
- .[b7].Resize(i - 1, j - 3) = brr
- End With
- ActiveWorkbook.Close True, ThisWorkbook.Path & "\顾客信息-" & x
- Next
- wb.Close
- End Sub
复制代码 |
评分
-
查看全部评分
|