Question

到目前为止，我有一个宏来查找一年并将其复制到新工作表。但是，我可能想要这个多年。我的数据集结构如下：

Col A   Col B   Col C   Col D   ColE
Year    Week    Amount  time    forecast
2000    1       368     2000w1  400
2000    2       8646    2000w2  8500
until...
2014    52      46546   2014w52 47000

到目前为止，我的宏是：

Sub Copyyear()
Dim Forecastyear As String
Dim Rng As Range
Dim cell As Range

Forecastyear = InputBox("Enter a year to forecast")

If Trim(Forecastyear) <> "" Then
    With Sheets(2)
        For Each cell In .Range("A:A")
            If cell.Value = Forecastyear Then 'find first occurrence of year
                Set Rng = cell
                Exit For
            End If
        Next
        '.Range(Rng.Address).Resize(52, 5).Select 'resize for 52 rows and 5 columns
        Rng.Resize(52, 5).Copy Destination:=Sheets("Moving Average").Range("A2")
    End With
End If

'   Record in new sheet
Worksheets("Moving Average").Select
    Range("A1").Value = "YEAR"
    Range("B1").Value = "WEEK"
    Range("C1").Value = "AMOUNT"
    Range("D1").Value = "TIME"
    Range("E1").Value = "FORECAST"

'   next macro
    AddForecastPerformance

End Sub

Answer 1

请在下方使用。年份如2001,2002,2003,2004等进入

Sub Copyyear()
Dim Forecastyear As String
Dim Rng As Range
Dim cell As Range

Forecastyear = InputBox("Enter year(s) to forecast, for multiple year input as 2001,2002,2003 etc")

If InStr(1, Forecastyear, ",") > 0 Then
    sp = Split(Forecastyear, ",")
    For i = 0 To UBound(sp)
        If Trim(sp(i)) <> "" Then
            With Sheets(2)
                For Each cell In .Range("A:A")
                    If cell.Value = CInt(sp(i)) Then 'find first occurrence of year
                        Set Rng = cell
                        Exit For
                    End If
                Next
                '.Range(Rng.Address).Resize(52, 5).Select 'resize for 52 rows and 5 columns
                Rng.Resize(52, 5).Copy Destination:=Sheets("Moving Average").Range("A2").Offset(0 + (52 * i), 0)
            End With
        End If
    Next
Else
    If Trim(Forecastyear) <> "" Then
        With Sheets(2)
            For Each cell In .Range("A:A")
                If cell.Value = Forecastyear Then 'find first occurrence of year
                    Set Rng = cell
                    Exit For
                End If
            Next
            '.Range(Rng.Address).Resize(52, 5).Select 'resize for 52 rows and 5 columns
            Rng.Resize(52, 5).Copy Destination:=Sheets("Moving Average").Range("A2")
        End With
    End If
End If

'   Record in new sheet
with Worksheets("Moving Average")
    .Range("A1").Value = "YEAR"
    .Range("B1").Value = "WEEK"
    .Range("C1").Value = "AMOUNT"
    .Range("D1").Value = "TIME"
    .Range("E1").Value = "FORECAST"
end with

'   next macro
    AddForecastPerformance

End Sub

复制输入框指示的多个范围

1 个答案: