Office中国论坛/Access中国论坛
标题:
请高手帮忙把这个宏修改一下让运行宏时不用先打开宏标卡文件夹中门店标卡（武汉）表格
[打印本页]
作者:
棋行天下黄
时间:
2009-6-6 13:21
标题:
请高手帮忙把这个宏修改一下让运行宏时不用先打开宏标卡文件夹中门店标卡（武汉）表格
本帖最后由 棋行天下黄 于 2009-6-6 19:12 编辑
由于每天大量数据要统计成标准的列为门店形式，行为品类形式的销售报表，做了这个宏，我们把这个宏标卡文件夹放在我的文档下，运行时先将宏标卡文件夹中门店标卡（武汉）表格打开，然后将原始数据打开，然后按ctrl+k，得到报表，但是运行前经常忘记将宏标卡文件夹中那个门店标卡文件打开，导致运行错误，请高手帮忙把这个宏修改一下让运行宏时不用先打开宏标卡文件夹中门店标卡（武汉）这个表格即可运行，原始文件可以在任何路径，标卡文件我都放在我的文档宏标卡下，谢谢了，如果您还能在门店增加时，不用修改宏自动在合计前统计增加门店的销售更加万分感谢!
宏的编辑文档：
Sub Macro2()
'
' Macro2 Macro
' 宏由 wangyingping 录制，时间: 2009/6/4
'
' 快捷键: Ctrl+k
Range("A2").Select
Selection.Insert Shift:=xlDown
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="1"
Cells.Select
Range("A2").Activate
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'[门店标卡（武汉）.xls]品类对应部门'!C1:C2,2,0)"
Selection.AutoFill Destination:=Range("B2:B100"), Type:=xlFillDefault
Range("B2:B100").Select
ActiveWindow.SmallScroll Down:=-84
Range("B1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="<>#N/A", Operator:=xlAnd
Cells.Select
Range("B1").Activate
Selection.Copy
Sheets("Sheet1").Select
Sheets.Add
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet2").Select
Sheets.Add
Application.CutCopyMode = False
Selection.Consolidate Sources:= _
"'Sheet2'!R1C2:R148C136" _
, Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'[门店标卡（武汉）.xls]品类对应部门'!C2:C3,2,0)"
Selection.AutoFill Destination:=Range("B2:B12"), Type:=xlFillDefault
Range("B2:B12").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "品类"
Range("B1").Select
ActiveCell.FormulaR1C1 = "序号"
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
Rows("1:22").Select
Selection.Copy
Sheets.Add
Sheets("Sheet4").Select
ActiveWindow.SmallScroll Down:=-15
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select
Sheets("Sheet4").Select
Sheets.Add
Range("A1").Select
ActiveCell.FormulaR1C1 = "='[门店标卡（武汉）.xls]门店顺序'!RC"
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:C1"), Type:=xlFillDefault
Range("A1:C1").Select
Selection.AutoFill Destination:=Range("A1:C100"), Type:=xlFillDefault
Range("A1:C100").Select
ActiveWindow.SmallScroll Down:=-135
Sheets("Sheet4").Select
Range("B1:K1").Select
Selection.Copy
Sheets("Sheet5").Select
Range("D1").Select
ActiveSheet.Paste
Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,2,0)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,2,0)/10000"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:M2"), Type:=xlFillDefault
Range("D2:M2").Select
ActiveWindow.ScrollColumn = 1
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,3,0)/10000"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,4,0)/10000"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,5,0)/10000"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,6,0)/10000"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,7,0)/10000"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,8,0)/10000"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,9,0)/10000"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,10,0)/10000"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,11,0)/10000"
Range("D2:M2").Select
Range("M2").Activate
ActiveWindow.ScrollColumn = 4
Selection.AutoFill Destination:=Range("D2:M100"), Type:=xlFillDefault
Range("D2:M100").Select
Cells.Select
Range("M2").Activate
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-126
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ActiveWindow.ScrollColumn = 1
With Selection.Font
.Name = "宋体"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.NumberFormatLocal = "0.00_ "
ActiveWindow.ScrollColumn = 1
Columns("A:C").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ActiveWindow.ScrollColumn = 4
ActiveWindow.SmallScroll ToRight:=2
Range("N1").Select
ActiveCell.FormulaR1C1 = "合计"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-10]:RC[-1])"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N42"), Type:=xlFillDefault
Range("A43").Select
ActiveCell.FormulaR1C1 = "合计"
Range("D43").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-41]C:R[-1]C)"
Range("D43").Select
ActiveWindow.SmallScroll Down:=3
Range("D43").Select
Selection.AutoFill Destination:=Range("D43:N43"), Type:=xlFillDefault
Range("D43:N43").Select
ActiveWindow.SmallScroll Down:=-42
ActiveWindow.ScrollColumn = 1
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "报表"
Sheets("Sheet4").Select
ActiveWindow.SelectedSheets.Visible = False
ActiveWindow.SelectedSheets.Visible = False
ActiveWindow.SelectedSheets.Visible = False
ActiveWindow.SelectedSheets.Visible = False
Sheets("报表").Select
End Sub
欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)
Powered by Discuz! X3.3