Excel VBA笔记2

原创 2007年09月15日 13:10:00
 Sub RowTransfer()
    Dim row As Long
    Dim col As Long
   
    Dim rangeStr As String
    Dim tempStr As String
   
    ' 目标Sheet页中的行标
    Dim i As Integer
   
    '源Sheet页与目标Sheet页
    Dim sourceSheet As String
    Dim destSheet As String
   
    ' 最大的行号,列号
    Dim maxRow As Integer
    Dim maxCol As Integer
   
    ' 目标表中的帐目编号、帐目名、帐目细项编号、帐目细项名的列号
    Dim acctIdCol As Integer
    Dim acctNameCol As Integer
    Dim acctItemIdCol As Integer
    Dim acctItemNameCol As Integer
   
    ' 目标表中的起始行号
    i = 2
   
    sourceSheet = "Sheet1"
    destSheet = "Sheet3"
   
    acctIdCol = 1
    acctNameCol = 2
    acctItemIdCol = 4
    acctItemNameCol = 3
    acctItemrateCol = 5
   
    '获取源Sheet最大行号
    maxRow = Worksheets(sourceSheet).Range("A65536").End(xlUp).row
   
    For row = 2 To maxRow
       
        '删除 首单元格 为空的行
        If Trim(Worksheets(sourceSheet).Cells(row, 1).Value) <> "" Then
            'Worksheets(sourceSheet).Cells(row, 1).EntireRow.Delete shift:=xlUp
           
            ' 获取该行最大列号
            rangeStr = "IV" & CStr(row)
            maxCol = Worksheets(sourceSheet).Range(rangeStr).End(xlToLeft).Column
           
            For col = 3 To maxCol Step 2
               
                '判断单元格是否为空, 若为空则退出循环
                If Trim(Worksheets(sourceSheet).Cells(row, col).Value) <> "" Then
                   
                    '获取源Sheet行首的项目号, 放入目标Sheet的第1列
                    Worksheets(destSheet).Cells(i, acctIdCol).Value = _
                        Worksheets(sourceSheet).Cells(row, 1).Value
                       
                    '获取源Sheet的项目名, 放入目标Sheet的第2列
                    Worksheets(destSheet).Cells(i, acctNameCol).Value = _
                        Worksheets(sourceSheet).Cells(row, 2).Value
                   
                    tempStr = Worksheets(sourceSheet).Cells(row, col).Value
                   
                    If InStr(tempStr, "*") > 0 Then
                   
                        '获取帐目内容,放入第二列
                        Worksheets(destSheet).Cells(i, acctItemNameCol).Value = _
                            Left(tempStr, InStr(tempStr, "*") - 1)
                   
                        '取分成比例,放入第四列
                        Worksheets(destSheet).Cells(i, acctItemrateCol).Value = _
                            Right(tempStr, Len(tempStr) - InStr(tempStr, "*"))
                    Else
                        Worksheets(destSheet).Cells(i, acctItemNameCol).Value = tempStr
                        Worksheets(destSheet).Cells(i, acctItemrateCol).Value = 1
                    End If
                   
                   
                    '获取帐目项编号, 放入第三列
                    Worksheets(destSheet).Cells(i, acctItemIdCol).Value = _
                        Worksheets(sourceSheet).Cells(row, col + 1).Value
                       
                    '目标表游标下移一行
                    i = i + 1
               
                End If
            Next col
        End If
    Next row
End Sub

Excel VBA高效办公应用-第十一章-教师员工数据管理-Part2 (课表助手小程序)

这个例子也不错,挺有启发性。 界面: 代码: Option Explicit Dim Iweek As Integer '定义Iweek获得当前的星期数 Sub Myfind() '定义Sst...

Excel VBA高效办公应用-第十三章-工资条与工资查询-Part2 (工资条查询)

同样,在如今的互联网时代,以下的工资条处理方式看上去太陈旧了。不过,十多年前,我自己还真领过这种格式的纸质工资条。哎呀,又暴露年龄了 不过,这个例子充分说明了Excel的强大。 Optio...

vba excel编程三日谈(2)

表格基本操作 由于表格操作内容繁多, 本文将以例子为主演示一些常用的操作. 下面的例子将演示怎么遍历worksheet,选中worksheet,添加worksheet,删除workshee...
  • nodeman
  • nodeman
  • 2015年07月31日 13:40
  • 380

Excel VBA 代码笔记

欢迎使用Markdown编辑器写博客本Markdown编辑器使用StackEdit修改而来,用它写博客,将会带来全新的体验哦: Markdown和扩展Markdown简洁的语法 代码块高亮 图片链接和...

Excel VBA高效办公应用-第十章-高效处理学员资料-Part2 (考勤记录表)

这个示例的意义在于,当数据量较大时,通过在用户窗体中提供筛选条件,帮助用户快速获取期望数据。 但应为使用多重筛选也能实现同样功能,所以,这里的做法有点鸡肋啊。 Option E...

Excel VBA与数据库(Access)整合笔记

  • 2017年06月01日 13:06
  • 218KB
  • 下载

Excel VBA高效办公应用-第八章-商品销售决策与分析-Part2 (商品分期付款决策)

今日彩蛋:模拟运算表(Data Table) "模拟运算表是一个单元格区域,它可显示一个或多个公式中替换不同值时的结果。有两种类型的模拟运算表:单输入模拟运算表和双输入模拟运算表。单输入模拟运算表中...

vba excel电话号码的导入(sheet1 to sheet2)

excel模式为: sheet1: sheet2: 然后选择 工具—宏—vb编译器:加入模块 写入代码: Sub zxl_input_phone() Set sh2 =...

Excel VBA 宏速查笔记

  • 2008年12月09日 23:09
  • 376KB
  • 下载

Excel VBA学习笔记

  • 2011年05月27日 13:41
  • 757KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Excel VBA笔记2
举报原因:
原因补充:

(最多只允许输入30个字)