|
Private Sub CommandButton1_Click()
Set d = CreateObject("Scripting.dictionary")
Set d2 = CreateObject("Scripting.dictionary")
Set d3 = CreateObject("Scripting.dictionary")
row_1 = [e1].End(xlDown).Row
row_2 = [x1].End(xlDown).Row
use_arr = [e1].Resize(row_1, 3)
buy_arr = [x1].Resize(row_2, 3)
ReDim b(1 To UBound(buy_arr, 1))
For i = 2 To UBound(use_arr, 1)
If d.Exists(use_arr(i, 1)) Then
d(use_arr(i, 1)) = d(use_arr(i, 1)) + use_arr(i, 2) * use_arr(i, 3)
Else
d(use_arr(i, 1)) = use_arr(i, 2) * use_arr(i, 3)
End If
Next
For i = 2 To UBound(buy_arr, 1)
If d2.Exists(buy_arr(i, 1)) Then
d2(buy_arr(i, 1)) = d2(buy_arr(i, 1)) + buy_arr(i, 2) * buy_arr(i, 3)
Else
d2(buy_arr(i, 1)) = buy_arr(i, 2) * buy_arr(i, 3)
End If
Next
For i = 1 To UBound(buy_arr, 1)
If d3.Exists(buy_arr(i, 1)) Then
b(i) = ""
ElseIf Not d.Exists(buy_arr(i, 1)) Then
b(i) = ""
ElseIf d.Exists(buy_arr(i, 1)) And d2.Exists(buy_arr(i, 1)) Then
d3(buy_arr(i, 1)) = d(buy_arr(i, 1)) / d2(buy_arr(i, 1))
b(i) = d(buy_arr(i, 1)) / d2(buy_arr(i, 1))
Else
b(i) = ""
End If
Next
[AC1].Resize(UBound(buy_arr, 1), 1) = Application.Transpose(b)
Set d = Nothing
Set d2 = Nothing
Set d3 = Nothing
End Sub
|
|