'å¼ç¨ï¼
'æ·»å 对该对象çå¼ç¨ å·¥ç¨èå-->å¼ç¨ï¼æ¾å° Microsoft Scripting Runtime
'å¼ç¨microsoft Excel 14.0 object library
'
Dim elApp As Excel.Application
Dim elBooks As Excel.Workbook
Dim ekSheet As Excel.Worksheet
Dim TblMap_Card 'å建ä¸ä¸ªåé
Private Sub Command1_Click()
Dim i As Integer
openEl
Set dic = CreateObject("Scripting.Dictionary")
'MsgBox ekSheet.Cells(Rows.Count, 1).End(3).Row
For i = 2 To ekSheet.Cells(Rows.Count, 1).End(3).Row
If dic.Exists(ekSheet.Cells(i, 2).Value) Then
dic(ekSheet.Cells(i, 1).Value) = dic(ekSheet.Cells(i, 1).Value) + ekSheet.Cells(i, 2).Value
Else
dic(ekSheet.Cells(i, 1).Value) = ekSheet.Cells(i, 2).Value
End If
Next i
ekSheet.Range("H:J").Clear
'ekSheet.Cells(1, 9).Resize(1, 2) = Array("åå", "å®é")
ekSheet.Cells(2, 9).Resize(dic.Count, 1) = Application.Transpose(dic.Keys)
ekSheet.Cells(2, 10).Resize(dic.Count, 1) = Application.Transpose(dic.Items)
End Sub
Private Sub openEl()
Dim myPath As String
myPath = "\week.xlsx"
Set elApp = CreateObject("Excel.Application")
Set elBooks = elApp.Workbooks.Open(App.Path & myPath)
Set ekSheet = elBooks.Worksheets("Sheet1")
'Set ekSheet = elBooks.Worksheets(1)
elApp.Visible = True
End Sub
追é®æ±ä¸å¤å¶ç²è´´