基于数据验证列表的动态列复制/粘贴 - VBA

时间:2018-01-01 21:41:29

标签: excel vba excel-vba validation

新年快乐!

背景:在每个月末,我们将预测销售额(公式所在位置)作为硬编码复制/粘贴到其他列中,以供参考和对帐。因此,例如,将列D(一月)到列F(三月)复制到列Q(jan硬编码)到S(行进硬编码)

所以我试图弄清楚如何修改我的代码,以便用户可以从每个预测选项卡上的月份范围(jan-mar eg)中选择2个数据验证下拉列表来复制/粘贴为值。 / p>

例如,下面是我根据公式的#行复制/粘贴的内容。

Dim LastRow As Long
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("T1") = "PPU"
Range("T2") = "=S2/R2"
Range("T2").Copy
Range("T2:T" & LastRow).Select `dynamic row
Selection.PasteSpecial xlFormulas
Range("T:T").Copy
Range("T:T").PasteSpecial xlPasteValues

因此,使用上面的代码,是否可以改变这一点,而不是“& Lastrow”,我将行保持静态,但使列复制变量,因此缺少更好的术语firstMonth&第二个月。要选择的列将基于2个命名范围,用户从2个数据验证列表(firstMonth& secondMonth)中选择,每列分配一个“字母”列(例如,Jan是列D,2月列E等。 。)

因此,如果没有动态,它将是一个简单的事情:

Range("D12:F19").Copy
Range("Q12").PasteSpecial xlValues

但是我希望用户通过数据验证列表选择月份,通过选择开始月份(firstMonth)和结束月份(secondMonth)进行硬编码

这就是:

Range(firstMonth &"12": secondMonth & "19").Copy `firstMonth in theory is the column letter so, "D12" and secondMonth is the second column letter (F12)
Range("pasteFirstMonth &"12").PasteSpecial xlValues `the firstMonth will be paired with the column letter, say "Q" where it will paste those values.  A second column range isn't needed here since only the copied range will paste, not overlapping anything else.  This is the "hardcoded" area.

更新:稍微重新配置Tim的答案。

Sub copyColumns()

Dim months, m1, m2, sht

    months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")
    Set sht = ActiveSheet

    m1 = Application.Match(sht.Range("Month1").Value, months, 0)
    m2 = Application.Match(sht.Range("Month2").Value, months, 0)

    sht.Range(sht.Cells(8, 3 + m1), sht.Cells(16, 3 + m2)).Copy
    sht.Range(sht.Cells(8, 16 + m1), sht.Cells(16, 16 + m2)).PasteSpecial xlValues

End Sub

2 个答案:

答案 0 :(得分:0)

这样的事情应该有效:

Sub DoCopy()

    Dim months, m1, m2, sht

    months = Split("Jan,Feb,Mar,Apr,May,June,July,Aug,Sept,Oct,Nov,Dec", ",")
    Set sht = ActiveSheet

    m1 = Application.Match(sht.Range("Month1").Value, months, 0)
    m2 = Application.Match(sht.Range("Month2").Value, months, 0)

    If Not IsError(m1) And Not IsError(m2) Then
        'copy range - use offset (3 here) depending on where months begin
        sht.Range(sht.Cells(12, 3 + m1), sht.Cells(19, 3 + m2)).Copy
        'etc
    End If

End Sub

答案 1 :(得分:0)

您可以提示用户选择所需的月份,您可以使用Selection对象,例如

Set rng=Selection
Cells(rng.row, rng.column) gives you the top left cell of the selection, 
rng.Columns.Count gives you the number of columns, etc.

从用户的角度来看,选择屏幕上的区域并按下按钮比输入值或从列表中选择值要容易得多。