Question

我有一个列表，其中包含与这些间隔相关联的日期间隔和货币转换。见下面的例子：

Start Date  Close Date  EUR
30/03/2013  26/04/2013  1.18
30/03/2013  26/04/2013  1.18
27/04/2013  24/05/2013  1.19
25/05/2013  28/06/2013  1.17
29/06/2013  26/07/2013  1.17
27/07/2013  23/08/2013  1.16
24/08/2013  27/09/2013  1.16 
28/09/2013  25/10/2013  1.19
26/10/2013  22/11/2013  1.17
23/11/2013  27/12/2013  1.2
28/12/2013  24/01/2014  1.2
05/01/2014  21/02/2014  1.21
22/02/2014  28/03/2014  1.21
29/03/2014  25/04/2014  1.21
26/04/2014  23/05/2014  1.21
04/05/2014  27/06/2014  1.24
08/06/2014  25/07/2014  1.25
26/07/2014  22/08/2014  1.26
23/08/2014  25/09/2014  1.25
26/09/2014  23/10/2014  1.28

我需要将每个日期间隔转换为单行，包括间隔内的所有可能日期，并保持相应的转换率。因此，对于第一个日期间隔，它将是：

30/03/2013  1.18
31/03/2013  1.18
01/04/2013  1.18
02/04/2013  1.18
03/04/2013  1.18
04/04/2013  1.18
05/04/2013  1.18
06/04/2013  1.18
07/04/2013  1.18
08/04/2013  1.18
09/04/2013  1.18
10/04/2013  1.18
11/04/2013  1.18
12/04/2013  1.18
13/04/2013  1.18
14/04/2013  1.18
15/04/2013  1.18
16/04/2013  1.18
17/04/2013  1.18
18/04/2013  1.18
19/04/2013  1.18
20/04/2013  1.18
21/04/2013  1.18
22/04/2013  1.18
23/04/2013  1.18
24/04/2013  1.18
25/04/2013  1.18
26/04/2013  1.18

对于所有日期范围，有没有这么容易？我在excel中想出了类似的东西：

=IF(AND(A1>='Sheet1'!$A$1, A1<='Sheet1'!$B$1), 'Sheet1'!$C$1)，A1 =包含日期的当前单元格; Sheet1！A1 =开始日期; Sheet1！B1 =关闭日期; C1 =欧元转换

问题是每次条件不适用时我都需要它移动到下一行。意思是，每次分析的日期超出相关区间时，我需要在Sheet1中将行位置增加一。任何帮助，将不胜感激。 VBA会好的。

最佳，安东尼奥

Answer 1

喜欢这个吗？

Option Explicit

Sub GenerateAllInfo()

    Dim inputArr()
    inputArr = Worksheets("Sheet1").Range("A2:C21").Value 'Exludes header

    Dim i As Long, y As Long, rowCounter As Long
    Application.ScreenUpdating = False

    For i = LBound(inputArr, 1) To UBound(inputArr, 1)
        For y = inputArr(i, 1) To inputArr(i, 2)
            rowCounter = rowCounter + 1
            With Worksheets("Sheet2")
                .Cells(rowCounter, 1) = y
                .Cells(rowCounter, 2) = inputArr(i, 3)
            End With
        Next y
    Next i
    ActiveSheet Columns("A:A").NumberFormat = "dd/mm/yyyy"
    Application.ScreenUpdating = True
End Sub

如果日期的数量太大而Transpose无法处理，否则可以用数组完成并直接写入工作表：

 Option Explicit

Sub GenerateAllInfo()

    Dim inputArr()
    inputArr = Worksheets("Sheet1").Range("A2:C21").Value 'Exludes header. 
    Dim outputArr
    ReDim outputArr(1 To 2000, 1 To 2)

    Dim i As Long, y As Long, rowCounter As Long
    Application.ScreenUpdating = False

    For i = LBound(inputArr, 1) To UBound(inputArr, 1)
        For y = inputArr(i, 1) To inputArr(i, 2)
            rowCounter = rowCounter + 1
            outputArr(rowCounter, 1) = y
            outputArr(rowCounter, 2) = inputArr(i, 3)
        Next y
    Next i

    outputArr = Application.WorksheetFunction.Transpose(outputArr)

    ReDim Preserve outputArr(1 To 2, 1 To rowCounter)
    outputArr = Application.WorksheetFunction.Transpose(outputArr)

    With Worksheets("Sheet2")
        .Range("A2").Resize(UBound(outputArr, 1), UBound(outputArr, 2)).Value = outputArr
        .Columns("A:A").NumberFormat = "dd/mm/yyyy"
    End With

    Application.ScreenUpdating = True
End Sub

Answer 2

代码中的小变化。

ActiveSheet列（“A：A”）。NumberFormat =“m / d / yyyy”

到

ActiveSheet.Columns（“A：A”）。NumberFormat =“m / d / yyyy”

For / while循环，在excel中具有双重条件

2 个答案: