[分享] 带你入门VBA（2004第一期）

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

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

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

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

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

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

I want to VBA!

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

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

zhi

斑主

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

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

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

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

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

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

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

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