Question

我正在尝试编写代码来查找相同的日期，并将'interestAmount'添加到同一日期，而没有单独的重复列。所以，假设我在05/01/2014有兴趣大约5美元，如果我发现另一个日期也是05/01/2014，interestAmount $ 10，那么我只需添加旧列，但新的interestAmount现在是15美元。我写的代码不起作用。请注意，“blah”是包含原始数据的工作表，我希望数据位于工作表“woot”上。非常感谢你的帮助。这是我的代码。

在Excel工作表上，工作表“blah”看起来像这样

           E               V              W
1      100000       5/8/2014    6/8/2014
2      100143.14    5/30/2014   6/30/2014
3      7784.73      5/4/2014    6/4/2014
4      100143.14    5/30/2014   6/30/2014                                                               
5      100143.14    5/15/2014   6/15/2014

代码：

Private Sub CommandButton1_Click()

Dim interestDate(1 To 5) As Date
Dim interestInterval(1 To 5) As Integer
Dim interestAmount(1 To 5) As Double

Dim theDate As Date
Dim index As Variant

For i = 1 To 5

interestInterval(i) = DateDiff("d", ThisWorkbook.Sheets("blah").Cells(i, 22), ThisWorkbook.Sheets("blah").Cells(i, 23))
interestDate(i) = ThisWorkbook.Sheets("blah").Cells(i, 23)
interestAmount(i) = (ThisWorkbook.Sheets("blah").Cells(i, 5).Value * 0.0237 * interestInterval(i)) / 365

theDate = ThisWorkbook.Sheets("woot").Cells(1, i)
index = Application.Match(CLng(theDate), Range("woot!1:1"), 0)

If IsError(index) Then
    MsgBox "if"
    MsgBox (i)
    ThisWorkbook.Sheets("woot").Cells(1, i) = interestDate(i)
    ThisWorkbook.Sheets("woot").Cells(3, i) = interestAmount(i)

Else
    MsgBox "else"
    MsgBox (index)
    ThisWorkbook.Sheets("woot").Cells(3, index) = interestAmount(index) + interestAmount(i)
End If
Next

End Sub

vba Excel-找到具有匹配功能的相同日期

0 个答案: