|
こんにちは
私もひとつ作ってみましたのでよろしければどうぞ。^d^
Sub AddFromCSV()
Dim Dic As Object
Dim myRange As Range
Dim myCell As Range
Dim myPath As String
Dim N As Integer
Dim K As String
Dim Item1 As Integer, Item2 As Integer
Set Dic = CreateObject("Scripting.Dictionary")
'処理対象セル範囲
Set myRange = ActiveSheet.UsedRange
For Each myCell In myRange.Columns(1).Cells
Set Dic.Item(myCell.Value) = myCell
Next
'読み込むCSVファイル
myPath = ThisWorkbook.Path & "\test.csv"
N = FreeFile
Open myPath For Input As #N
Line Input #N, K 'タイトル読み飛ばし
Do Until EOF(N)
Input #N, K, Item1, Item2
If Dic.Exists(K) Then
Set myCell = Dic.Item(K)
Else
Set myCell = myRange.Cells(1, 1).End(xlDown).Offset(1)
myCell.Value = K
Set Dic.Item(K) = myCell
End If
With myCell
.Offset(, 1).Value = .Offset(, 1).Value + Item1
.Offset(, 2).Value = .Offset(, 2).Value + Item2
End With
Loop
Close #N
Set myCell = Nothing
Set myRange = Nothing
Set Dic = Nothing
End Sub
|
|