（Excel VBA）根据多个条件查找值

Question

我有一个包含两列的表。它们分别代表日期和相应的值。我想要做的是获取每个月的平均值，并创建另一个月平均值和年份的表。我用“for”编写了一个简单的代码，它完美地运行但是需要一段时间，因为有大约40000行。我很好奇是否有其他方法可以在明显更短的时间内完成。谢谢。

TABLE
...
09.07.1908  63.5
10.07.1908  59.7
11.07.1908  49
12.07.1908  44.7
.......
.......
12.05.2003  32.45
13.05.2003  38.33
.......



 OUTPUT
        JANUARY FEBRUARY MARCH ...  
 1908    12.53    23.45  45.87 ...
 1909    45.23    14.43  23.54 ...
 .................................
 .................................
 2014    23.65    56.87  12.43 ...




Dim i, j, index1, index2 As Integer
Dim mean, sum As Double

index1 = 0 
index2 = 1
For i = 1908 To 2014
  For j = 1 To 12
    For k = 3 To 39000
      If Month(Sheet1.Cells(k, 1).Value) = j And Year(Sheet1.Cells(k,1).Value) = i Then
      sum = sum + Sheet1.Cells(k, 2).Value
      index1 = index1 + 1
      End If
    Next
  mean = sum / index1
  Sheet5.Cells(index2 + 2, j + 1).Value = sum / index1
  sum = 0
  index1 = 0
  Next
index2 = index2 + 1
Next

Answer 1

使用数组读取数据的速度要快一些，但一次写入所有数据可以轻松地将代码加速到大型数据集上100倍。处理39000行x 2列并写入1行x 13列（标题行）并写入106行x 13列：0.125秒。

Sub Refactor()
    Dim Start: Start = Timer
    Dim arData, arSums(1908 To 2014, 0 To 12), arCounts(1908 To 2014, 1 To 12)
    Dim m As Long, x As Long, y As Long

    With Sheet1
        arData = .Range("A3", .Range("B" & Rows.Count).End(xlUp)).Value2
    End With

    For x = 1 To UBound(arData, 1)
        m = Month(arData(x, 1))
        y = Year(arData(x, 1))

        arSums(y, m) = arSums(y, m) + arData(x, 2)
        arCounts(y, m) = arCounts(y, m) + 1
    Next

    For x = LBound(arSums, 1) To UBound(arSums, 1)
        arSums(x, 0) = x

        For y = 1 To 12
            If Not IsEmpty(arCounts(x, y)) Then arSums(x, y) = arSums(x, y) / arCounts(x, y)
        Next
    Next

    Sheet5.Range("A1").Resize(1, 13) = Array("Year", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    Sheet5.Range("A2").Resize(106, 13).Value = arSums
    Debug.Print Timer - Start
End Sub