|
|
楼主 |
发表于 2015-8-5 00:59
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub cnn_db()
- Dim arr, brr, crr, drr, err, frr, MyPath$, MyName1$, Sql$, m%, n%, i%, k%, r%
- Dim cnn As Object
- On Error Resume Next
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- MyPath = ActiveWorkbook.Path & ""
- MyName1 = "TxSEIK.CSV"
- MyName2 = "TxSEIK(7月度内示比较).XLS"
- Workbooks.Open Filename:=MyPath & MyName2
- r2 = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
- drr = Range("B2:B" & r2)
- err = Range("H2:J" & r2)
- Set d = CreateObject("scripting.dictionary") '创建字典
- For j = 1 To r2 - 1
- d.Item(drr(j, 1)) = err(j, 1) & "_" & err(j, 2) & "_" & err(j, 3) '修改关键字所对应的条目，如果不存在此关键字则自动添加此条目对
- Next
- ActiveWindow.Close True
- Workbooks.Open Filename:=MyPath & MyName1
- Set cnn = CreateObject("ADODB.Connection")
- cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ActiveWorkbook.FullName
- Sql = " select * from [TxSEIK$] where [区分]=""生计"" and [制造担当] like 'S%' and [制造担当] <>""S125"" and [制造担当] <>""S160"" and [制造担当] <>""S172"" order by [制造担当]"
- Workbooks.Add
- Workbooks(MyName1).Worksheets(1).[a1:fi1].Copy ActiveWorkbook.Worksheets(1).[a1]
- ActiveWorkbook.Worksheets(1).[a2].CopyFromRecordset cnn.Execute(Sql)
- ActiveWorkbook.SaveAs Filename:=MyPath & Split(MyName1, ".")(0) & "调整.csv", FileFormat:=xlCSV
- cnn.Close
- Set cnn = Nothing
- Workbooks(MyName1).Close True
-
- '------------第二步的处理过程----------------
- Columns("H:P").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
- Columns("M:N").NumberFormatLocal = "0.00%"
- Columns("O:P").NumberFormatLocal = "0.0_ "
- arr = Array("收容数", Month(Date) & "月", Month(DateAdd("m", 1, Date)) & "月", _
- "（" & Month(DateAdd("m", -1, Date)) & "月发行）" & Month(Date) & "月", _
- "（" & Month(DateAdd("m", -1, Date)) & "月发行）" & Month(DateAdd("m", 1, Date)) & "月", _
- Month(Date) & "月差异率", Month(DateAdd("m", 1, Date)) & "月差异率", _
- Month(Date) & "月差异箱数", Month(DateAdd("m", 1, Date)) & "月差异箱数")
- Range("H1:P1") = arr
- r = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
- brr = Range("Q1:EH" & r)
- frr = Range("B2:B" & r)
- m = 0
- n = 0
- ReDim crr(2 To r, 1 To 9)
- For k = 1 To UBound(brr, 2)
- If Month(Application.Text(brr(1, k), "0000-00-00")) = Month(Date) Then
- If m = 0 Then
- min1 = k
- m = 1
- Else
- max1 = k
- End If
- ElseIf Month(Application.Text(brr(1, k), "0000-00-00")) = Month(DateAdd("m", 1, Date)) Then
- If n = 0 Then
- min2 = k
- n = 1
- Else
- max2 = k
- End If
- End If
- Next
- For i = 2 To r
- crr(i, 1) = crr(i, 2) = crr(i, 3) = crr(i, 4) = crr(i, 5) = 0
- crr(i, 1) = Split(d(frr(i - 1, 1)), "_")(0) '2.指定H列第一行名字为：收容数 根据对应的项目编码（B列）去“TxSEIK(7月度内示比较)”套取相应的数据
- crr(i, 4) = Split(d(frr(i - 1, 1)), "_")(1) '5.指定K列第一行名字为：上月发行（当月的月份） 去TxSEIK(7月度内示比较) 根据项目编码（B列）套取数据{固定I列}
- crr(i, 5) = Split(d(frr(i - 1, 1)), "_")(2) '6.指定L列第一行名字为：上月发行（下月的月份） 去TxSEIK(7月度内示比较) 根据项目编码（B列）套取数据{固定J列}
- For k = min1 To max1
- crr(i, 2) = crr(i, 2) + brr(i, k) '3.指定I列第一行名字为：当月的月份（变量）套取本身工作表Q~EH列对应月份的 总量
- Next
- For k = min2 To max2
- crr(i, 3) = crr(i, 3) + brr(i, k) '4.指定J列第一行名字为：当月的月份+1月 套取本身工作表Q~EH列对应月份的 总量
- Next
- crr(i, 6) = (crr(i, 2) - crr(i, 4)) / crr(i, 4) '7.指定M列第一行名字为：当月份差异率 =(I8-K8)/K8
- crr(i, 7) = (crr(i, 3) - crr(i, 5)) / crr(i, 5) '8.指定N列第一行名字为：当月份+1月差异率 =(J8-L8)/L8
- crr(i, 8) = (crr(i, 2) - crr(i, 4)) / crr(i, 1) '9.指定O列第一行名字为：当月份差异箱数 =(I8-K8)/H8
- crr(i, 9) = (crr(i, 3) - crr(i, 5)) / crr(i, 1) '10. 指定P列第一行名字为：当月份+1差异箱数 =(J8-L8)/H8
- Next
- Range("H2:P" & r) = crr
- '---------------------------------------------
- ActiveWorkbook.SaveAs Filename:=MyPath & Split(MyName1, ".")(0) & "(" & Month(Date) & "月度内示比较).xls", FileFormat:=xlExcel8
- ActiveWindow.Close True
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
|
|
楼主: hyjianjian
沪公网安备 31011702000001号 沪ICP备11019229号-2
