Question

我有一张excel表，有10个不同的列，有几百条记录。

e.g。

column1|column2|column3|column4

data    data    data    data

我有另一张纸，一个模板，其标题以某种方式排列，例如

column1|column2
data    data
        column3   column 4
        data      data

因此，我的第二张纸中的模板块必须复制并填写每条记录。

有没有办法用VBA做到这一点？

我知道这是一种可怕的做事方式，但我不能说服我的上司，所以这就是我可以尝试做的事情。如果这是不可能的，那只能手工完成，所以我希望可以实现一些自动化。

Answer 1

试试这个：

Sub Tester()

    Const SHT_SRC As String = "Sheet1" 'sheet w source data
    Const SHT_DEST As String = "Sheet2" 'sheet w template
    Const RNG_COPY As String = "A1:E6" 'your template area

    Dim rngDest As Range, rngSrc As Range, rngCopy As Range

    Set rngCopy = ThisWorkbook.Sheets(SHT_DEST).Range(RNG_COPY)
    Set rngDest = rngCopy.Cells(1)
    Set rngSrc = ThisWorkbook.Sheets(SHT_SRC).Rows(2)

    Do While rngSrc.Cells(1).Value <> ""

        rngCopy.Copy rngDest 'copy template area
        With rngDest
            'adjust offsets to fit your template layout
            .Offset(1, 0).Value = rngSrc.Cells(1).Value
            .Offset(1, 1).Value = rngSrc.Cells(2).Value
            '...etc etc
            .Offset(5, 5) = rngSrc.Cells(10).Value
        End With

        Set rngDest = rngDest.Offset(rngCopy.Rows.Count + 1, 0)
        Set rngSrc = rngSrc.Offset(1, 0)
    Loop

End Sub

Answer 2

您可以将范围读入数组，然后通过单个元素解析：

Dim dataArray As Variant
Dim i As Integer

dataArray = Range("B1:B4").Value

For i = 1 to Ubound(dataArray)/2
  Range("B2").Offset(2 * (Ceiling(i/2)-1), Ceiling((i-1)/2)) = dataArray(1, i)
Next i

使用此功能：

Public Function Ceiling(ByVal X As Double) As Integer

  Ceiling = Int(X) - (X - Int(X) > 0)

End Function

以特定方式重新格式化Excel数据

2 个答案: