列数据插入的问题

杨小妹

附件 列数据插入附件.rar (81.41 KB, 下载次数: 6)

2024-6-29 09:49 上传

点击文件名下载附件

谢谢老师！

Qs18

Sub qs()
    With Sheet1
        Dim arr, brr, i
        arr = .Range("a1").CurrentRegion
        ReDim brr(1 To UBound(arr) * 2, 1 To 1)
        For i = 1 To UBound(arr)
            m = m + 1
            brr(m, 1) = arr(i, 1)
            m = m + 1
            brr(m, 1) = arr(i, 2)
        Next
        .Range("p1").Resize(m, 1) = brr
    End With
End Sub

Qs18

试一下...........

Qs18

试一下...........

风雨声点滴

Sub xx()
Dim a, b, c(), d
a = Range("a1").End(xlDown).Row
d = 0
For b = 1 To a
    ReDim Preserve c(d)
    c(d) = Cells(b, 1)
    d = d + 1
    ReDim Preserve c(d)
    c(d) = Cells(b, 2)
    d = d + 1
  Next b
  Range("E1").Resize(UBound(c), 1) = Application.Transpose(c)
End Sub

3190496160

Sub 插入数据()
Dim ar As Variant
Dim br()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:b" & r)
    ReDim br(1 To UBound(ar) * 2, 1 To 1)
    For i = 1 To UBound(ar)
        If ar(i, 1) <> "" Then
            n = n + 2
            br(n - 1, 1) = ar(i, 1)
            br(n, 1) = ar(i, 2)
        End If
    Next i
    .Columns(14) = Empty
    .[n1].Resize(n, 1) = br
End With
MsgBox "ok!"
End Sub

3190496160

3190496160

列数据插入附件.rar (146.4 KB, 下载次数: 2)

2024-6-29 10:26 上传

点击文件名下载附件

MHanys

~~~~~~~~~~~~~~~~~~~~

木槿花西月锦绣

公式解法