带你入门VBA（2004第一期）

zhou_yc

不明白如何传附件, 只好这样传了.

目的: 一个订单依各项的型号规格,来到总用量表中调用用量. 并将结果整理到一个新建表中去. 这样可以避免太多人工的计算.

Columns("c:E").Select Range("B3").Activate Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False

'这段的作用是去掉那些空格,否则会对以后的操场作有影响.

Range("A3").Select

Columns("A:C").Select Selection.Find(What:="套码", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, MatchByte:=False, SearchFormat:=False).Activate a = ActiveCell.Row d = ActiveCell.Column '以上是确认所要计算的销售订单项目范围 Columns("A:C").Select Selection.Find(What:="remark", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate

b = ActiveCell.Row If Cells(2, 1) = "" And Cells(3, 1) = "" And Cells(4, 1) = 0 And Cells(5, 1) = 0 Then Columns("a:a").Select

Selection.Delete

End If

'以上是为了删除第一列为空的销售订单

For i = a - 7 To b - 10

Cells(i + 9, 11).Select ActiveCell.FormulaR1C1 = "=IF(RC[-9]<>0,RC[-8]&RC[-7],"""")" Cells(i + 9, 12).Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-10]<>0,VLOOKUP(RC[-1],'[皮用量(TEST).xls]Sheet1'!R2C3:R15560C6,2,0),"""")" Cells(i + 9, 13).Select ActiveCell.FormulaR1C1 = "=if(RC[-11]<>0,RC[-1]*RC[-8],"""")" Cells(i + 9, 14).Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-12]<>0,VLOOKUP(RC[-3],'[皮用量(TEST).xls]Sheet1'!R2C3:R15560C6,3,0),"""")" Cells(i + 9, 15).Select ActiveCell.FormulaR1C1 = "=if(RC[-13]<>0,RC[-1]*RC[-10],"""")" Cells(i + 9, 16).Select ActiveCell.FormulaR1C1 = _ "=IF(RC[-14]<>0,VLOOKUP(RC[-5],'[皮用量(TEST).xls]Sheet1'!R2C3:R15560C6,4,0),"""")" Cells(i + 9, 17).Select ActiveCell.FormulaR1C1 = "=if(RC[-15]<>0,RC[-1]*RC[-12],"""")" Next i '以上是从皮用量表中找出对应的皮单耗,并计算出总用量 Range("b9:b150,e9:f150,k9:q150").Select Selection.Copy Range("a1").Select Worksheets.Add ActiveSheet.Name = "Leather" Sheets("Leather").Select Range("a4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '以上是将原表的计算值复制到新的表中 Range("a1").Select Application.CutCopyMode = False

For l = 1 To 4

For k = 4 To 160 If Cells(k, 4) = "" Then

Cells(k, 4).Select Selection.EntireRow.Delete End If Cells(k, 4).Select Next k Cells(1, 1).Select Next l '以上是删除那些没有数据的空白行

Range("a3").Value = "Item" Range("b3").Value = "QTY" Range("c3").Value = "Leather" Range("d3").Value = "Model&config" Range("e3").Value = "Full" Range("f3").Value = "Full_T" Range("g3").Value = "Front" Range("h3").Value = "Fro_T" Range("i3").Value = "Back" Range("j3").Value = "Back_T" Cells.Select Cells.EntireColumn.AutoFit Range("a1").Select Sheets("sheet1").Select Range("k:l").Select Selection.Delete Range("A3:b15").Select Selection.Find(What:="no", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, MatchByte:=False, SearchFormat:=False).Activate

ActiveCell.Offset(0, 1).Select ActiveCell.Offset(0, -1).Select

Selection.Copy Sheets("leather").Select

Range("a1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '以上是复制销售订单号码到皮用量表中 Application.CutCopyMode = False

Range("A3").Select ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ "Leather!R3C1:R100C10").CreatePivotTable TableDestination:="", TableName:= _ "PivotTable9", DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1) ActiveSheet.Cells(3, 1).Select With ActiveSheet.PivotTables("PivotTable9").PivotFields("Leather") .Orientation = xlRowField .Position = 1 End With ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _ "PivotTable9").PivotFields("Full_T"), "Sum of Full_T", xlSum ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _ "PivotTable9").PivotFields("Fro_T"), "Sum of Fro_T", xlSum ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _ "PivotTable9").PivotFields("Back_T"), "Sum of Back_T", xlSum ActiveSheet.PivotTables("PivotTable9").PivotSelect "", xlDataAndLabel, True ActiveSheet.PivotTables("PivotTable9").Format xlTable10 '以在是将运行结果用数据透视表的形式计算出,存在新的文件中. Selection.Copy Sheets("Leather").Select Range("a3").Select

Selection.End(xlDown).Select ActiveCell.Offset(2, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("C:J").EntireColumn.AutoFit Range("a3").Select Selection.CurrentRegion.Select Application.CutCopyMode = False Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range("c3").Select Selection.End(xlDown).Select ActiveCell.Offset(3, 0).Select

Selection.CurrentRegion.Select Application.CutCopyMode = False Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With '以上是给两个表格划线而已! Selection.End(xlDown).Select

With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.2) .RightMargin = Application.InchesToPoints(0.2) .TopMargin = Application.InchesToPoints(1) .BottomMargin = Application.InchesToPoints(1) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0.5) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 300 .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed End With Range("C3").Select Selection.End(xlDown).Select Selection.End(xlDown).Select Selection.End(xlDown).Select ActiveCell.Offset(0, -1).Select

ActiveCell.FormulaR1C1 = "=COUNTIF(RC2:RC4,""#N/A"")" '这边一直有问题,还没改好呢? If ActiveCell.Value > 0 Then MsgBox "皮用量资料不全,请先维护原始的皮用量表,然后重新运行此宏!" '这边一直有问题,还没改好呢? Else: MsgBox "资料齐全,你可以打印了, 祝你工作愉快!" End If ActiveCell.Clear End Sub

就是最后一段一直不如意,也一直没改我, 已经想了一天了.

ysh_red

我要学习

一只小虾米

好！我也来参加学习了！刚才看了半个多小时终于看完了，还有得学的吗？今天是11-7号。已有3天没更新了？是没有问的还是老师太忙了，请多出点题吧。

非常感谢兰老师，我非常敬佩您！

lyc_721006

I want to VBA!

elf0486

老师,你好,我有一个Excel文件,关系到一些机密问题,但又不得不给我的一个朋友,这个文件里面用了一些公式和函数,我不想这些公式和函数被他看到,而且关于使用上我只想让他在我指定的位置进行数据输入,我想到了将指定位置解除锁定,然后将含有公式和函数的地方进行隐藏,再将工作表保护起来,设定解除密码,但这种方法一旦将工作表全部选定后再复制到其它工作表上后即失效! 现在才知道可用VBA来解决,可我现在又急需要,能否帮忙编一个程序,限制复制、剪切、粘贴、另存，而且最好有阅读次数和时间限制，谢谢！另外，再请教一下，VBA是什么软件，是哪几个英文的简称，这个问题很菜，多谢指教！

wzbfuture

可以把创建按纽的方式给我说说吗

我用的是英文版excel,怎么照你们的方法创建不可按纽啊

zhi

wzbfuture

以下是引用兰色幻想在2004-10-3 22:50:00的发言：

都可以执行宏，控件工具箱中的按纽有属性项，窗体里没有，比如：窗体里的控件不能编辑按纽背影颜色，而控件工具箱里的按纽可以

斑主

可以把图形，窗体，控件工具箱建按钮的三种方式说一下

我用英文版的excel，照着你们的法子弄不好

龙云枫

好像几天没有更新了.

XK421

[QUOTE][/QUOTE]

“此工作簿的宏已被禁用，因为其安全性为高，......”我把安全级别改为“中”或“低”，为什么还是不能用啊？

maxlia的问题我也遇到过，每当我打开EXCEL时，个人宏工作簿会自动打开，但是会提示“该工程中的宏被禁用”，重新打开EXCEL也没用，个人宏工作簿中的宏也不能用，但是单独打开个人宏工作簿，效果就不一样了，不知道是为什么？

[em06][em06]

XK421

Sub 矩形2_单击() Dim i As interge For i = 1 To 15 Sheet("sheet1").cell(i, 2) = x + 100 Next Range("b16").Value = Application.WorksheetFunction.Sum(Range("b1: b15 ")) End Sub

哪位高手能帮我看看我的代码有问题吗？

为什么老是显示“在中断模式中不能执行代码”呢？

为什么会有“中断模式”？