多次复制粘贴特殊（转置），有更好的方法吗？

问题描述 投票：0回答：1

这是一个由两部分组成的问题。 我对使用 VBA 还很陌生，这是我使用它的第一个项目。 在我的工作表中，我有 60 行 15 列数据，每行 15 个数据输入代表一个场景。 我希望宏复制每行中的数据，将其转置到单独的输入字段，然后计算输出到 P 列中输入行旁边的单元格。这是最有效的运行方式吗？

第二个代码集是我尝试绕过循环并仅为宏中的每一行输入运行第一个宏。 我知道必须有更好的方法来做到这一点作为循环或其他东西，我的知识库只是有限的。

Sub Final()
Dim Cell_Reference As Range

Set Cell_Reference = Range("P" & Rows.Count).End(xlUp).Offset(1)


Range(Cell_Reference.Offset(, -15), Cell_Reference.Offset(, -1)).Copy
Range("R4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Range("R20").Copy
Range("P" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial xlPasteValues
Range("R4:R18").Select
Selection.ClearContents


End Sub


Sub Run_Final()
'
' Macro2 Macro
'

'
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
End Sub
excel vba
1个回答
0
投票

使用循环获取每个场景的输出

Sub Final()
    Dim Cell_Reference As Range
    Dim lastRowP As Long, lastRowA As Long, i As Long, aRes()
    lastRowP = Range("P" & Rows.Count).End(xlUp).Row
    lastRowA = Range("A" & Rows.Count).End(xlUp).Row
    If lastRowA <= lastRowP Then Exit Sub
    ReDim aRes(1 To lastRowA - lastRowP, 0)
    For i = lastRowP + 1 To lastRowA
        Range("R4").Resize(15, 1).Value = Application.Transpose(Cells(i, 1).Resize(1, 15).Value)
        aRes(i - lastRowP, 0) = Range("R20").Value
    Next
    Cells(lastRowP + 1, "P").Resize(lastRowA - lastRowP, 1).Value = aRes
    Range("R4").Resize(15, 1).ClearContents
End Sub
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.