|
|
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
|
评分
-
1
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2015-8-4 00:53
楼主
发表于 2015-8-4 09:19
