Question

所以我很擅长在excel中使用VBA。所以请忍受我的无知。

我有一列深度以米为单位，对应一个间隔。我想将每个间隔下的4个深度粘贴到右边。这将是一个简单的复制和粘贴，但我希望自动化这一点。我已经尝试在VBA中编写一些代码，但我遇到的错误可能与我对语法的有限理解有关。

这可能是一种更容易实现的方法，我会全力以赴。

提前感谢您的帮助！

            1   2   3

1 6129
1 6112
1 6094
1 6077
2 6059
2 6041
2 6024
2 6006
3 5989
3 5971
3 5953
3 5936

Sub copyperfs()

Dim i As Long, intervals As Long, j As Long, numperfs As Long

Dim offsetcell As Range, offsetcell_paste As Range
Dim startpos As Range, start_paste As Range

'enter number of perforations per interval
numperfs = 4
'enter number of intervals
intervals = 42

Set startpos = Range("AF3")
Set startpos_paste = Range("AI3")

startpos.Select

For i = 1 To intervals
    startpos.Select
    Set startpos = ActiveCell
    Set offsetcell = ActiveCell.Offset(numperfs, 0)
'copy range of perfs
    Range(startpos & ":" & offsetcell).Copy
'go to area to paste cells
    startpos_paste.Select
    Set startpos_paste = ActiveCell
    Set offsetcell_paste = ActiveCell.Offset(numperfs, 0)
    Range(startpos_paste & ":" & offsetcell_paste).PasteSpecial
'go over to the right 1 column
    startpos_paste = ActiveCell.Offset(0, 1)

'move start postition
    startpos = offsetcell.Offset(1, 0)
Next
End Sub

Answer 1

Sub x()

Dim l As Long
Dim l2 As Long

l = 1
l2 = 1

Do Until Range("a" & l).Value = ""

    Range("b" & l2).Resize(1, 4).Value = Application.Transpose(Range("a" & l).Resize(4, 1).Value)

    l = l + 4
    l2 = l2 + 1

Loop

End Sub

将单列数据拆分为多列

1 个答案: