excel VBA是否动态选择静态多行集上的单个列引用?

68de4m5k  于 2023-01-14  发布在  其他
关注(0)|答案(2)|浏览(140)

我正在为我的组织中的某个人创建一个报告。该报告有多个方案,他们希望通过复制一个方案并将其粘贴到列中进行测试,然后进行计算。他们复制的部分不是按固定顺序,即它是多个选择(E30:E34,E37:E39等),但它们都在同一列(例如E),并且多个选择上的行号引用对于每个方案来说总是相同的。我只需要将列引用从E一直更改为AW(将来可能会更多)。我在想,也许有办法在每个方案上方设置一个单元格,用作“复选框”,vba代码可以查找该复选框,以便使用该列引用。或者可能只是一个输入框,以便键入他们想要的列字母。我编写了一个循环代码,正在运行多个选择和复制粘贴,我将在下面发布。我只需要一种方法来动态更改rArray中的列引用(E到F或G或H等),我希望这是可能的。谢谢!
这是我必须复制和粘贴选定范围的代码:

Sub CopyScenario()

    Dim rArray(1 To 22) As Range
    Dim tArray(1 To 22) As Range

'Set up ranges for selected scenario

    Set rArray(1) = Sheets("LMA").Range("E30:E34")
    Set rArray(2) = Sheets("LMA").Range("E37:E39")
    Set rArray(3) = Sheets("LMA").Range("E41")
    Set rArray(4) = Sheets("LMA").Range("E43:E44")
    Set rArray(5) = Sheets("LMA").Range("E47:E50")
    Set rArray(6) = Sheets("LMA").Range("E52")
    Set rArray(7) = Sheets("LMA").Range("E54")
    Set rArray(8) = Sheets("LMA").Range("E56:E57")
    Set rArray(9) = Sheets("LMA").Range("E59:E60")
    Set rArray(10) = Sheets("LMA").Range("E64:E66")
    Set rArray(11) = Sheets("LMA").Range("E69:E70")
    Set rArray(12) = Sheets("LMA").Range("E72")
    Set rArray(13) = Sheets("LMA").Range("E83:E87")
    Set rArray(14) = Sheets("LMA").Range("E89:E91")
    Set rArray(15) = Sheets("LMA").Range("E93:E95")
    Set rArray(16) = Sheets("LMA").Range("E99:E100")
    Set rArray(17) = Sheets("LMA").Range("E102:E103")
    Set rArray(18) = Sheets("LMA").Range("E106")
    Set rArray(19) = Sheets("LMA").Range("E111:E118")
    Set rArray(20) = Sheets("LMA").Range("E123:E124")
    Set rArray(21) = Sheets("LMA").Range("E126:E130")
    Set rArray(22) = Sheets("LMA").Range("E133:E135")
    
'Set ranges for calc info to be pasted in

    Set tArray(1) = Sheets("LMA").Range("C30")
    Set tArray(2) = Sheets("LMA").Range("C37")
    Set tArray(3) = Sheets("LMA").Range("C41")
    Set tArray(4) = Sheets("LMA").Range("C43")
    Set tArray(5) = Sheets("LMA").Range("C47")
    Set tArray(6) = Sheets("LMA").Range("C52")
    Set tArray(7) = Sheets("LMA").Range("C54")
    Set tArray(8) = Sheets("LMA").Range("C56")
    Set tArray(9) = Sheets("LMA").Range("C59")
    Set tArray(10) = Sheets("LMA").Range("C64")
    Set tArray(11) = Sheets("LMA").Range("C69")
    Set tArray(12) = Sheets("LMA").Range("C72")
    Set tArray(13) = Sheets("LMA").Range("C83")
    Set tArray(14) = Sheets("LMA").Range("C89")
    Set tArray(15) = Sheets("LMA").Range("C93")
    Set tArray(16) = Sheets("LMA").Range("C99")
    Set tArray(17) = Sheets("LMA").Range("C102")
    Set tArray(18) = Sheets("LMA").Range("C106")
    Set tArray(19) = Sheets("LMA").Range("C111")
    Set tArray(20) = Sheets("LMA").Range("C123")
    Set tArray(21) = Sheets("LMA").Range("C126")
    Set tArray(22) = Sheets("LMA").Range("C133")
    
'Copy paste loop thru ranges
    
    Dim i, j As Integer
    
    For i = 1 To 22
    rArray(i).Copy
    j = 0
        Do Until Sheets("LMA").Cells(21 + j, 21).Value = ""
            j = j + 1
        Loop
    tArray(i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next
    

End Sub
23c0lvtd

23c0lvtd1#

尝试其他范围语法:

Dim columnRef as Long:  columnRef = 5
'Dim columnRef as String:  columnRef = "E"
'Dim columnRef as Long:  columnRef = Selection.Column
With Sheets("LMA")
    .Range( .Cells( 1, columnRef), .Cells( 2, columnRef))
End With

可以使用columnRef作为特定列的引用。
至于拉取Selection.Column,你有很多方法可以做到,在这里你必须给予你的具体例子,每一种方法都有不同的相关代码。

olmpazwi

olmpazwi2#

复制单列区域

  • 请注意,这是我的选择,需要引用工作表。
  • 如果代码总是在包含工作表的工作簿中,那么只需要重新排列(修改)几行就可以调用它,例如使用CopyColumns "LMA", 5, 3,或者如果它是特定于工作表的,则使用简单的CopyColumns 5, 3
    利用率
Sub CopyColumnsTEST()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("LMA")
    
    CopyColumns ws, "E", "C"
    'or equivalently:
    'CopyColumns ws, 5, 3
    
End Sub

方法

Sub CopyColumns( _
         ByVal ws As Worksheet, _
         ByVal SourceColumn As Variant, _
         ByVal DestinationColumn As Variant)
         
    Dim RowsAddress As String: RowsAddress _
        = "30:34,37:39,41:41,43:44,47:50,52:52," _
        & "54:54,56:57,59:60,64:66,69:70,72:72," _
        & "83:87,89:91,93:95,99:100,102:103,106:106," _
        & "111:118,123:124,126:130,133:135"
        
    Dim rrg As Range: Set rrg = ws.Range(RowsAddress)
    Dim srg As Range: Set srg = Intersect(rrg, ws.Columns(SourceColumn))
    Dim drg As Range: Set drg = Intersect(rrg, ws.Columns(DestinationColumn))
    
    Dim n As Long
    
    For n = 1 To srg.Areas.Count
        drg.Areas(n).Value = srg.Areas(n).Value
    Next n

End Sub

相关问题