关闭

Excel VBA笔记2

425人阅读 评论(0) 收藏 举报
 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
0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:22872次
    • 积分:312
    • 等级:
    • 排名:千里之外
    • 原创:7篇
    • 转载:4篇
    • 译文:1篇
    • 评论:3条
    文章分类