|
- Private Sub CommandButton2_Click()
- Dim arr
- Dim brr
- Dim dic
- Dim My_path As String
-
- Dim i As Long
- Dim x As Long
- Dim y As Long
-
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
-
- arr = Sheet1.Range(Cells(1, 1), Cells(Sheet1.Range("a65536").End(xlUp).Row, Sheet1.Range("IV1").End(xlToLeft).Column))
- My_path = ThisWorkbook.Path & ""
- Workbooks.Open (My_path & "顾客信息登记表.xls")
-
- Set dic = CreateObject("scripting.dictionary")
-
- For x = 1 To 3
- Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("c" & x + 3) = arr(2, x)
- Next
-
- brr = Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("b7:" & Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("IV7").End(xlToLeft).Address)
-
- For i = 1 To UBound(brr, 2)
- dic.Item(brr(1, i)) = ""
- Next
- For i = 2 To UBound(arr)
- If i = 2 Then
- For x = 5 To UBound(arr) - 1
- dic.Item(arr(1, x)) = arr(i, x)
- Next
-
- Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("b" & Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("b65536").End(xlUp).Row + 1).Resize(1, dic.Count) = dic.items
-
- ElseIf arr(i, 2) = arr(i - 1, 2) Then
- For x = 5 To UBound(arr) - 1
- dic.Item(arr(1, x)) = arr(i, x)
- Next
-
- Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("b" & Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("b65536").End(xlUp).Row + 1).Resize(1, dic.Count) = dic.items
- ElseIf arr(i, 2) <> arr(i - 1, 2) Then
-
- Workbooks("顾客信息登记表.xls").SaveAs Filename:=My_path & Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("c5") & ".xls"
- ActiveWorkbook.Close
- Workbooks.Open (My_path & "顾客信息登记表.xls")
-
- For y = 1 To 3
- Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("c" & y + 3) = arr(i, y)
- Next
- For x = 5 To UBound(arr) - 1
- dic.Item(arr(1, x)) = arr(i, x)
- Next
-
- Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("b" & Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("b65536").End(xlUp).Row + 1).Resize(1, dic.Count) = dic.items
- End If
- Next
-
- Workbooks("顾客信息登记表.xls").SaveAs Filename:=My_path & Workbooks("顾客信息登记表.xls").Sheets("顾客信息").Range("c5") & ".xls"
- ActiveWorkbook.Close
-
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
复制代码
好了 自己试试看吧 |
|