2016-09-24 59 views
0

我有一個包含兩列的表。它們分別代表日期和相應的值。我想要做的是得到每個月的平均值,並創建另一個月平均值和年份表。我用「for」編寫了一個簡單的代碼,它完美地工作,但由於有大約40000行,所以需要一段時間。我很好奇,如果有其他方法可以在很短的時間內完成。謝謝。(Excel VBA)根據多個標準查找值

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 
+0

如果你的代碼的工作,你只是想看看它的最佳優化然後將其張貼到[代碼審查(http://codereview.stackexchange.com/) – user3598756

回答

2

使用數組讀取數據有點快,但一次寫入所有數據可以輕鬆地將大量數據集中的代碼加快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 

enter image description here

+0

謝謝大家了很棒的信息。這真的是一個「重大」差異:)。 – nsfrt

+0

歡迎您。快樂編碼! – 2016-09-24 13:40:23