将行分成2行,将特定单元格划分到每一行

时间:2017-10-18 17:57:01

标签: excel excel-vba vbscript vba

我需要使用excel vba将每行复制为2行,其中orignal行中的某些列分为第1行和第2行。我需要的内容如下所示:

输入数据:
合同___ VIN #____利息$ ___主$
contract1 ___ 1234 ____ $ 20 ________ $ 400
contract2 ___ ABCD ____ $ 40 ________ $ 600

期望的输出:
合同___ VIN #____金额$
contract1 ___ 1234 20 ____ $
contract1 ___ 1234 ____ $ 400
contract2 ___ ABCD 40 ____ $
contract2 ___ ABCD ____ $ 600

我正在努力学习如何精确浏览范围的行和列的概念......我认为这将是一个for循环?

非常感谢任何帮助

1 个答案:

答案 0 :(得分:1)

使用 F8

逐步浏览每一行来研究此代码
Option Explicit

Public Sub SplitRows()
    Application.ScreenUpdating = False

    Dim newWs As Worksheet
    With ThisWorkbook.Worksheets
        Set newWs = .Add(After:=Worksheets(.Count))         'Add a new ws
        newWs.Name = Format(Now, "yyyy-mmm-dd hh-mm-ss")    'Rename it
    End With

    newWs.Range("A1:C1") = Split("Contract VIN# Amount$")   'Add headers to the new ws

    Dim colA As Range
    With ThisWorkbook.Worksheets("Sheet1").UsedRange        'Get UsedRange in colA (Sheet1)
        Set colA = .Columns("A").Offset(1).Resize(.Rows.Count - 1, 1)
    End With

    Dim itm As Range, oldRow As Long, newRow As Long
    oldRow = 1

    For Each itm In colA.Cells
        oldRow = oldRow + 1     'increment row on old sheet (Sheet1)
        newRow = newRow + 2     'increment row on new sheet (double)
        With newWs
            .Cells(newRow, "A") = Sheet1.Cells(oldRow, "A")     'row1new(A) = row1old(A)
            .Cells(newRow, "B") = Sheet1.Cells(oldRow, "B")     'row1new(B) = row1old(B)
            .Cells(newRow, "C") = Sheet1.Cells(oldRow, "C")     'row1new(C) = row1old(C)
            .Cells(newRow + 1, "A") = Sheet1.Cells(oldRow, "A") 'row2new(A) = row1old(A)
            .Cells(newRow + 1, "B") = Sheet1.Cells(oldRow, "B") 'row2new(B) = row1old(B)
            .Cells(newRow + 1, "C") = Sheet1.Cells(oldRow, "D") 'row2new(C) = row1old(D)
        End With
    Next
    Application.ScreenUpdating = True
End Sub