可羡瑶池碧桃树:VISUAL BASIC 代码汇总

visual basic 代码汇总
EXCEL 2000与EXCEL XP版代码互换方法：
1、把XP版代码换成2000版：把“, MatchByte:=False, SearchFormat:=False”替换成无内容即可。
2、把2000版代码换成XP版：
 “MatchCase:=False).Activate”替换成
 “MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate”即可

选定工作表：《检查结果》。Sheets("检查结果").Select

选定单元格：选定B3单元格:RANGE("B3").SELECT
   CELLS(3,2).SELECT    '(先行号再列号)
     选定由变量决定的单元格:RANGE("B" & Left(总行数, 5)).SELECT
      :CELLS(行变量,列变量).SELECT     
选定列：I致J列。Columns("I:J").Select

选定行：10到11行。Rows("10:10").Select
 由变量决定的行范围：Rows("11:" & Left(总行数, 5)).Select
  Rows(Left(总行数, 5) & ":" & Left(总行数, 5)).Select
  Range("B" & Left(总行数, 5)).EntireRow.Select

选定区域：选A10到U1000：Range("A10:U1000").Select
   选A到U列：Range("A:U").Select
   选2到10行：Range("2:10").Select
   选定由变量决定的区域Range("B2:H" & Left(总行数, 5)).Select

Sheets("item").Select
            Sheets("item").Columns("b:c").Find(What:=Itemid, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate

自动填充：Selection.AutoFill Destination:=Range("B2:B500")
填充到变量行:Selection.AutoFill Destination:=Range("B2:B" & Left(总行数 - 1, 4))

输入公式
在B2单元格填入=VLOOKUP(A2,销售表草稿!G:I,2,0)
在代码中表示为
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],销售表草稿!C[5]:C[7],2,0)"
在B2单元格填入=VLOOKUP(A2,销售表草稿!A:C,2,0)
在代码中表示为
Range("B2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],销售表草稿!C[-1]:C,2,0)"

替换，将'#N/A’替换为'本月有销售无入库’
Columns("B:B").Select
Selection.Replace What:="#N/A", Replacement:="本月有销售无入库", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

选定可定区域
Range("A1").Select
'先选定当前单元格周围有数据的范围
Selection.CurrentRegion.Select
'再选定当前区域的可见部分
Selection.SpecialCells(xlCellTypeVisible).Select
'复制选定的区域
Selection.Copy

清除选定区域内容
Range("A9:A" & Left(总行数, 5)).Select
Selection.ClearContents

在选定区域插入内容，活动单元格下移
Range("A1").Select 或Range("2:10").Select
Selection.Insert Shift:=xlDown
ActiveCell.FormulaR1C1 = "装调机型"

删除行，活动单元格上移
Rows("11:14").Select
Selection.Delete Shift:=xlUp

查找
Range("A:A").Select
Selection.Find(What:="3机顶盒(内外销)", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp

EXCEL 表中中间有空白行,但又要确定最后行的位置时,代码如下:    
Columns("E:E").Select
Selection.Find(What:="总计", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False).Activate
总行数 = ActiveCell.Row

但要注意,在程序最后要加回以下代码,以将查找的选项恢复回默认值.
Columns("E:E").Select
Selection.Find(What:="总计", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False).Activate

要求输入内容
IPUT = InputBox("请输入月份数。例“08”", "", 8)

将一个单元格内容赋值给变量
变量名 = Range("D8").Value

循环结构
DO WHILE 条件
..
LOOP
For 变量名 = 6 To 25
..
Next 当前凭证行号

判断结构
IF 条件 THEN
..
ENDIF

以下程序运行出错时的处理方法待研究
'On Error GoTo A
    'A:
      'ActiveWorkbook.Save

如果出现:"类 RANGE 的 SELECT 方法无效"的错误提示
可以考虑 对象前加上上一级对象的名称之引用
如Range("D15:D46").Select
改为Sheets("packing").Range("D15:D46").Select

将当前表另存为EXCEL文件
Sheets("Sheet1").Copy
  iFile = ActiveWorkbook.Path & "\Sheet1.xls"
  ActiveWorkbook.SaveAs Filename:=iFile

激活选定工作簿并关闭
Workbooks("工作簿名").Worksheets("print").Activate   
ActiveWindow.Close

Sub 判断单元格是否为空()
    For 列号 = 24 To 2
        分红 = Range("A1").Value
        If 分红 = "" Then
            分红 = 1
        Else
            分红 = 2
        End If
        Range("B3").Value = 分红
   
    Next 列号
End Sub

调用 宏
CALL 宏名字

提高运行速度代码

程序开始写:
'获得当前的Excel设置状态,将其放置在代码的开头
Application.Calculation = xlCalculationAutomatic
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents
displayPageBreakState = ActiveSheet.DisplayPageBreaks '注:这是工作表级的设置
'关闭一些Excel功能使代码运行更快
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
'Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False '注:这是工作表级的设置

程序结束写:

Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState