Excel自动oracle巡检,每日gross requirement , oracle里的数据,批量处理(一)-ExcelVBA程序开发-ExcelHome技术论坛 -...

Sub 每周一三表合并()

'Application.ScreenUpdating = False

'

'Dim name1 As Integer, name2 As Integer, tt As String, Response As Integer

'tt = Timer

'    If Not FileExists("d:\Documents\Desktop\给同事写的VBA\媚周一GROSS REQUIREMENT\ERGOTRON_Supply_Chain_Planning_" & Format(Date - 1, "ddmmyy") & "-P04.xls") Then '调用函数FileExists来判断

'         name1 = 0

'         Else

'         name1 = 1

'         End If

'     If Not FileExists("d:\Documents\Desktop\给同事写的VBA\媚周一GROSS REQUIREMENT\ERGOTRON_Supply_Chain_Planning_" & Format(Date - 1, "ddmmyy") & "-P06.xls") Then '调用函数FileExists来判断

'         name2 = 0

'         Else

'         name2 = 1

'         End If

'    If name1 + name2 = 2 Then '打开两个表格

'    Response = MsgBox("您的报表好了,  go on?", vbYesNo)

'

'                    If Response <> 6 Then

'                    Exit Sub

'                    Else

'                    End If

Workbooks.Open ("d:\Documents\Desktop\给同事写的VBA\媚周一GROSS REQUIREMENT\ERGOTRON_Supply_Chain_Planning_" & Format(Date - 1, "ddmmyy") & "-P04.xls")

Workbooks.Open ("d:\Documents\Desktop\给同事写的VBA\媚周一GROSS REQUIREMENT\ERGOTRON_Supply_Chain_Planning_" & Format(Date - 1, "ddmmyy") & "-P06.xls")

'    Else

'    MsgBox "P04和P06还没有出来!"

'    Exit Sub

' End If

'新建表格并命名

Workbooks.Add

ActiveWorkbook.SaveAs ("D:\魅周一\DGE GROSS REQUIREMENT " & Format(Date, "yyyymmdd") & ".xlsx")

' 新表表头

Windows("ERGOTRON_Supply_Chain_Planning_" & Format(Date - 1, "ddmmyy") & "-P04.xls").Activate

Range("C16").Select

Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy

Range("C14").Select

ActiveSheet.Paste

Range("A14").Select

Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy

Windows("DGE GROSS REQUIREMENT " & Format(Date, "yyyymmdd") & ".xlsx").Activate

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _

, SkipBlanks:=False, Transpose:=False

'第一个表格

Windows("ERGOTRON_Supply_Chain_Planning_" & Format(Date - 1, "ddmmyy") & "-P04.xls").Activate

Range("B1048564").Select

Selection.End(xlUp).Select

Dim r1 As Integer

r1 = ActiveCell.Row

Range("A15:B" & r1).Select

Selection.UnMerge

'填充

Dim ar, i%, j%

ar = Selection

For j = 1 To UBound(ar, 2)

For i = 2 To UBound(ar)

If ar(i, j) = "" Then ar(i, j) = ar(i - 1, j)

Next

Next

Selection = ar

Rows("14:" & r1 + 14).Select

Selection.AutoFilter

ActiveSheet.Range("A14:S" & r1).AutoFilter Field:=3, Criteria1:="Gross"

Range("A20:S20").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Copy

Windows("DGE GROSS REQUIREMENT " & Format(Date, "yyyymmdd") & ".xlsx").Activate

Range("A2").Select

ActiveSheet.Paste

'第二个表

Windows("ERGOTRON_Supply_Chain_Planning_" & Format(Date - 1, "ddmmyy") & "-P06.xls").Activate

Range("B1048564").Select

Selection.End(xlUp).Select

Dim r2 As Integer

r2 = ActiveCell.Row

Range("A15:B" & r2).Select

Selection.UnMerge

i = 0

j = 0

ar = Selection

For j = 1 To UBound(ar, 2)

For i = 2 To UBound(ar)

If ar(i, j) = "" Then ar(i, j) = ar(i - 1, j)

Next

Next

Selection = ar

Rows("14:" & r2 + 14).Select

Selection.AutoFilter

ActiveSheet.Range("A14:S" & r2).AutoFilter Field:=3, Criteria1:="Gross"

Range("A20:S20").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Copy

Windows("DGE GROSS REQUIREMENT " & Format(Date, "yyyymmdd") & ".xlsx").Activate

Dim a As Integer

a = [a1].CurrentRegion.Rows.Count

Cells(a + 1, 1).Activate

ActiveSheet.Paste

Range("D2").Select

ActiveWindow.FreezePanes = True

Columns("A:A").ColumnWidth = 13.55

Columns("B:B").ColumnWidth = 13.75

Rows("1:6").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.EntireRow.AutoFit

' 找到Planned orders

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值