【Excel】Excel 的一些笔记

1. 计算sheet中的最后一行

     last_r_f = Sheets("房产数据").UsedRange.Rows.count

     last_r = Range("A65536").End(xlUp).Row

2. 计算某个单元格的个数

    count = Application.WorksheetFunction.CountIf(Range("G" & i & ":G" & (i + 500)), Range("G" & i))

3. 计算某个含有特定字符串的单元格个数，利用find函数和findNext函数

   find函数找到一个后就立马进行返回，返回的值类型为range

    Dim findValue As Range
    Set findValue = Sheets("房产数据").Columns("J").Find(what:=quanliren)

    Dim count

    count = 0

    Do While Not findValue Is Nothing
          count = count + 1
          row_num = findValue.Row

          Set findValue = Sheets("房产数据").Columns("J").FindNext(After:=findValue)
           If findValue.Row <= row_num Then Exit Do
      Loop

4. 数组

    1）一维数组的定义   Dim arr(1 to 10)  或 Dim arr(0 to 9)

    2）二维数组的定义   Dim arr（1 to 10，0 to 9）

    3）动态数组

         Dim arr() 

         ReDim arr(0 to 10,1 to 9)  在使用的过程中增加长度。

    4）获取数组的索引的最大值和最小值或求数组的长度

           p = LBound(arr, 0)   获取二维数组中的第一维的索引的最小值
           p = UBound(arr, 1)   获取二维数组中的第二维的索引的最大值

5. 数据字典

   1）数据字典的创建

         Set dic = CreateObject("Scripting.dictionary")

    2）数据字典元素的新增

        dic.Add key, rvalue

    3）数据字典的读取或修改

        dic(key) = value

            For Each k In dic.keys
                  Range("Y" & i) = k
                  Range("T" & i & ":W" & i) = dic(k).Value
             Next

           dic.keys 获取所有的key

           dic.items 获取所有的item

    4）数据字典的长度  dic.count

    5）释放数据字典

         dic.removeAll  清空元素

         set dic = nothing  删除对象

   6）需创建相应的类模块，并设置类模块中的元素

   

5. range 区域

    Dim reg as range

    set reg = range（“A1：B5”）

    range("C1:D5") = reg.value

6. 类对象

    1）类的创建

         新建一个类模块，并重命名类模块的名称，即创建了一个类

         

      2）创建类的属性    

         Public hehao As String
         Public danghao As String

         Public xuhao As Variant

     3）创建类对象    属性的引用 对象名.属性名

         Set objAj = New CAnjuan
          objAj.xuhao = Range("A" & i & ":A" & i + count - 1).Value

  7. 为单元格赋予公式

      Range("T2:T" & last_r).FormulaR1C1 = "=RC[-11]&""-""&RC[-11]+RC[-10]-1" 

      RC为相对位置

8. 条件语句

    if 条件 then

         执行语句

    else if   条件 then

         执行语句

     else

          执行语句

    end if

9. 循环语句

       for i=1 to 100

            执行语句

        Next

 

       for each k in XXX

             执行语句

       next

 

       Do while 条件

             执行语句

        Loop

      跳出while循环  exit Do，跳出for循环 exit for

10. GoTo 语句

    Line1：语句1

                 语句2...

                 GoTo Line1

11. 条件选择语句

     select case express

           case express1

            执行语句

           case express2

           执行语句

           case else

            执行语句

      end select

12. 单元格格式修改

       Range("A7:D" & lastR).Font.Size = 11

       Cells(i, 27 + 5 * p).Font.Color = vbRed

       Columns("A:G").Font.Name = "宋体"

       Range("A24:D24").Merge

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

       Rows("1:1").RowHeight = 36

        Range("A2:G2").HorizontalAlignment = xlLeft
        Range("A2:G2").VerticalAlignment = xlBottom
        Columns("A:G").WrapText = True

       描边

          Range("A7:D" & lastR).Borders(xlEdgeLeft).LineStyle = xlContinuous
          Range("A7:D" & lastR).Borders(xlEdgeTop).LineStyle = xlContinuous
          Range("A7:D" & lastR).Borders(xlEdgeBottom).LineStyle = xlContinuous
          Range("A7:D" & lastR).Borders(xlEdgeRight).LineStyle = xlContinuous
          Range("A7:D" & lastR).Borders(xlInsideVertical).LineStyle = xlContinuous
          Range("A7:D" & lastR).Borders(xlInsideHorizontal).LineStyle = xlContinuous

          去掉边线

           Range("A7:D" & lastR).Borders(xlEdgeLeft).LineStyle = xlNone
           Range("A7:D" & lastR).Borders(xlEdgeTop).LineStyle = xlNone
           Range("A7:D" & lastR).Borders(xlEdgeBottom).LineStyle = xlNone
           Range("A7:D" & lastR).Borders(xlEdgeRight).LineStyle = xlNone
           Range("A7:D" & lastR).Borders(xlInsideVertical).LineStyle = xlNone
           Range("A7:D" & lastR).Borders(xlInsideHorizontal).LineStyle = xlNone

13. 表格

           File_path = ActiveWorkbook.Path

           File_name = ActiveWorkbook.Name

           Sheets("copy").Delete
           ActiveWorkbook.Save

          Windows(oldfileName).Activate

14. 关闭通知提示框

           Application.DisplayAlerts = False

           Application.DisplayAlerts = True

           On Error Resume Next   遇到错误继续执行

15. 调用sub

     call sub名

16. 调用函数

           function funname（s1 as string,s2 as string) as Double

                 执行语句

                  funname = value  返回函数值

             end function

            函数调用

            dim p as double

            p=funname("hahaha","heheh")

17. 创建工具栏           

          Sub auto_open()
               Call AddMenu
          End Sub

          Sub AddMenu()
                On Error Resume Next
                Application.CommandBars("房产工具").delete
    
                 Dim toolBar As CommandBar
                Set toolBar = Application.CommandBars.Add
                toolBar.Name = "房产工具"
                toolBar.Visible = True
    
                Dim toolButton As CommandBarControl
               Set toolButton = toolBar.Controls.Add
                       With toolButton
                                .Caption = "房产数据表"
                                .FaceId = 369
                                .OnAction = "CreateData"
                                .Style = msoButtonIconAndCaptionBelow
                        End With
               Set toolBar = Nothing
                Set toolButton = Nothing
End Sub

17. 创建宏文件

      在程序中打开office Excel软件，将代码拷贝进vba代码编辑器中，在vba编辑器中点击”保存“按钮

 18. 为宏文件设置密码

     在vba编辑器中选中宏模块，右键选中”VBAProjext属性“，在标签”保护“中设置密码。重启宏文件后密码生效。

  19. 创建文件夹

    '创建盒目录文件夹
    Dim backfilepath
    If Dir(File_path & "\案卷脊背\", vbDirectory) = "" Then
        MkDir (File_path & "\案卷脊背\")   '创建文件夹
    End If
    backfilepath = File_path & "\案卷脊背\"

    20. 获取当前目录，当前目录的上一级目录

  File_path = ActiveWorkbook.Path
    base_path = Left(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\"))

 

21.在某目录下查找文件，若没有打开，则打开该文件

Function MobanOpen(ByVal modelFileName As String, ByVal openPath As String) As Boolean
    Dim File_path
    Dim WB As Workbook
    Dim FoundWB As Boolean
    
    File_path = openPath
    
    '循环查找目录录路径下是否有查找的文件，如果已经打开，则返回已找到；如果已找到，但未打开，则打开该文件；否则返回未找到
    If Dir(File_path & "\" & modelFileName) <> "" Then
         FoundWB = False
         On Error Resume Next
         For Each WB In Application.Workbooks
             If WB.Name = modelFileName Then
                 FoundWB = True
                 Exit For
             End If
         Next WB
         If FoundWB = False Then
             Workbooks.Open File_path & "\" & modelFileName
         End If
         MobanOpen = True
    Else
        MobanOpen = False
        
    End If
End Function

22. 遍历某个文件路径下的所有Excel表

   Dir函数，返回带指定扩展名的文件名，若找到的不止一个，则返回第一个，若第二次调用不带任何参数的Dir，则返回指定扩展名的下一个文件名，如

   file1= Dir(file_path & "\" & "*.xls*")  '查找变量名file_path下第一个excel表名称并赋给变量file1

   file2=Dir  ‘查找下一个excel表名称并赋给变量file2

   Dir函数，返回一个String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标想匹配

   Dir[(pathname[, attributes])]

   

 '遍历当前路径下的所有Excel表，并进行处理
        '遍历所有的Excel表
    Sub text

        Dim arr As Variant
        arr = GetExcels(file_path)
        For k = 1 To UBound(arr)

            ...

        next k

     end Sub

 

 

 '遍历特定路径下的所有Excel表，并返回一个数组
Function GetExcels(ByVal filePath As String) As String()

    Dim excelName As String
    Dim arr() As String
    Dim k As Integer
    k = 1
    ReDim arr(1 To k)
    excelName = Dir(filePath & "\" & "*.xls*")
    arr(k) = excelName
    Do While excelName <> ""
        excelName = Dir
        If excelName = "" Then
            Exit Do
        End If
        k = k + 1
        ReDim Preserve  arr(1 To k)
        arr(k) = excelName
    Loop
    GetExcels = arr
   
End Function

23. 另存为Excel时，打开Excel表会提示与指定的格式不一致的解决方法

Excel2007或Excel2010默认的格式是 .xlsx,如果代码中另存为.xls时，打开另存为的excle表时就会弹出与指定的格式不一致的提示框，解决方法如下：

    ActiveWorkbook.SaveAs fileName:=newfile_path & fileName, FileFormat:=xlExcel8, CreateBackup:=False
fileformat由xlOpenXMLWorkbook 修改为xlExcel8       

24. 判断字符串中是否有汉字

假设字符串保存在StrChk变量中，那么只需要判断：

Len(StrChk)  与  LenB(StrConv(StrChk, vbFromUnicode)  是否相等，即可知道该变量中是否存在汉字。

理由如下：

VBA中默认英文字符串都是Unicode，双字节，

如果转化为vbFromUnicode，英文字符就变成单字节，汉字还是双字节，

如果转换之前的字符长度Len(StrChk) 与转化之后的字节长度LenB(StrConv(StrChk, vbFromUnicode)相等（LenB是计算字符的字节长度的函数），说明不含中文字符，反之含有中文字符

    '获取人员编号和姓名
    Dim renyuanNum, renyuanName
    renyuanNum = Left(fileName, 7)
    renyuanName = Mid(fileName, 8, Len(ActiveWorkbook.Name) - 11)
    If Len(renyuanNum) <> LenB(StrConv(renyuanNum, vbFromUnicode)) Then
        renyuanNum = Left(fileName, 4)
        renyuanName = Mid(fileName, 5, Len(ActiveWorkbook.Name) - 8)
    End If
    fileName = renyuanNum & "-" & renyuanName & ".xls"

25. 动态数组

先定义动态数组，每次使用的时候再使用redim重新定义数组大小

   Dim arr（） as string

   Dim k

   k=1

   redim Preserve  arr（1 to k）

　　①保留原值

　　采用此代码：ReDim Preserve MyStr(n)　'n为数组长度

　　②不保留原值

　　采用此代码：ReDim MyStr(n)　'n为数组长度

26. 获取数组的长度 UBound(arr)

 

27. 函数返回数组

Function GetExcels(ByVal filePath As String) As String()
    Dim arr() As String
    ....
    GetExcels = arr
End Function

接收函数返回的数组

Dim arr As Variant
arr = GetExcels(file_path)