zoukankan      html  css  js  c++  java
  • VBA练习-打开文件,添加选中项,生成新表

    学习VBA,正好给财务制作一个小工具:

    Sub 打开人员信息表()
        Dim wb As Workbook, c As Integer
        Set wb = Workbooks.Open("C:UserswznDocuments工作簿2.xlsx", 0, True)
        c = wb.Worksheets.Count
        If c < 3 Then wb.Worksheets.Add after:=Worksheets(Worksheets.Count)
        wb.Worksheets(1).Select
        
    End Sub
    
    
    Sub 添加选中人员()
        Dim fw As Worksheet, lw As Worksheet, fr As Integer, lr As Integer, rg As Range
        Set fw = ActiveSheet
        Set lw = Worksheets(Worksheets.Count)
        For Each rg In Selection
            fr = rg.Row
            If Range("a" & fr) = "" Or Range("b" & fr) = "" Then
                MsgBox "选中项不能是空值,请确认选中项后重试"
                Exit Sub
            End If
            lr = lw.Range("a65536").End(xlUp).Row + 1
            lw.Range("a" & lr) = Range("a" & fr)
            lw.Range("b" & lr) = Range("b" & fr)
        Next
        If lw.Range("a1") <> "姓名" Then
            lw.Range("a1") = "姓名"
            lw.Range("b1") = "卡号"
            lw.Range("c1") = "金额"
            
            With lw.Range("a1,b1,c1").Font
                .Name = "宋体"
                .Size = 12
                .Bold = True
            End With
        End If
        With lw.Range("a1").CurrentRegion
            .Borders.ColorIndex = 1
            .Columns.AutoFit
            .HorizontalAlignment = xlCenter
        End With
    End Sub
    
    Sub 导出添加人员()
        Dim lw As Worksheet, curBook As Workbook
        Set curBook = ActiveWorkbook
        Set lw = Worksheets(Worksheets.Count)
        lw.Move
        curBook.Close False
    End Sub
  • 相关阅读:
    以正确的方式开源 Python 项目
    一个备胎的自我修养
    关于我们 | 读书马上
    基于libevent, libuv和android Looper不断演进socket编程
    libuv 与 libev 的对比
    OCaml Language Sucks
    Practical Common Lisp
    learning
    WebApi系列~QQ互联的引入(QConnectSDK)
    知方可补不足~用xsl来修饰xml
  • 原文地址:https://www.cnblogs.com/lunawzh/p/5917969.html
Copyright © 2011-2022 走看看