| |
効率的では無いかも知れませんが、こんな物かな？
余りTestをしていないので上手く行くか？
ログのファイルと集計結果用のファイルが共にExcelのBookとします
マクロは、集計結果用のファイルに有る物とします
Dataは先頭行からデータで見だしは無い物とします
集計結果もA列にグループ名、B列に集計結果を書き込み、1列めが見出しとします
尚、ログのファイルがCSV、Textならまた別なやり方に成ります
標準モジュールに記述
Option Explicit
Public Sub AddUp()
Dim i As Long
Dim j As Long
Dim vntResult As Variant
Dim vntGroup As Variant
Dim lngGroupTop As Long
Dim lngGroupEnd As Long
Dim lngGroupCount As Long
Dim vntData As Variant
Dim lngDataCount As Long
'データの有るファイル名
Const strDataFile As String = "Data.xls"
'もしデータファイルが無い場合
If Dir(ThisWorkbook.Path & "\" & strDataFile) = "" Then
Beep
MsgBox "ファイルが有りません"
Exit Sub
End If
' Application.ScreenUpdating = False
'データファイルのOpen
Workbooks.Open ThisWorkbook.Path & "\" & strDataFile
'データファイルのSheet1
With Worksheets("Sheet1")
'データの取得
vntData = Range(.Cells(1, 1), _
.Cells(65536, 2).End(xlUp)).Value
End With
'データファイルのClose
Workbooks(strDataFile).Close SaveChanges:=False
'データの個数
lngDataCount = UBound(vntData, 1)
'データのソート
ShellSort vntData
'集計用シートのSheet1
With Worksheets("Sheet1")
'集計行の先頭
lngGroupTop = 2
'集計行の最終を取得
lngGroupEnd = .Cells(65536, 1).End(xlUp).Row
'集計Group名の取得
vntGroup = Range(.Cells(lngGroupTop, 1), _
.Cells(lngGroupEnd, 1)).Value
End With
'集計Group名の個数
lngGroupCount = UBound(vntGroup, 1)
'集計Group名配列の拡張
ReDim Preserve vntGroup(1 To lngGroupCount, 1 To 2)
'集計Group名配列に行位置を書き込み
For i = 1 To lngGroupCount
vntGroup(i, 2) = i + lngGroupTop - 1
Next i
'集計Group名配列のソート
ShellSort vntGroup
'集計結果配列の確保
ReDim vntResult(1 To lngGroupCount)
'集計
'データのカウンタの初期設定
j = 1
'集計Group名を１つづつ取り出す
For i = 1 To lngGroupCount
'データと比較
Do Until j > lngDataCount
'もし、データの中に取り出した集計Group名が有れば
If InStr(1, vntData(j, 1), _
vntGroup(i, 1), vbTextCompare) <> 0 Then
'結果用配列に加算
vntResult(i) = vntResult(i) + vntData(j, 2)
j = j + 1
Else
Exit Do
End If
Loop
Next i
'集計用シートのSheet1
With Worksheets("Sheet1")
'集計Group名の全てを書き込み
For i = 1 To lngGroupCount
.Cells(vntGroup(i, 2), 2).Value = vntResult(i)
Next i
End With
' Application.ScreenUpdating = True
End Sub
別な標準モジュールに記述
Option Explicit
Option Compare Text
Public Sub ShellSort(vntList As Variant)
Dim i As Long
Dim j As Long
Dim lngGap As Long
Dim vntTmp(1) As Variant
Dim lngTop As Long
Dim lngEnd As Long
lngTop = LBound(vntList, 1)
lngEnd = UBound(vntList, 1)
lngGap = 1
Do While lngGap < (lngEnd - lngTop + 1) \ 3
lngGap = 3 * lngGap + 1
Loop
Do Until lngGap <= 0
For i = lngGap + lngTop To lngEnd
vntTmp(0) = vntList(i, 1)
vntTmp(1) = vntList(i, 2)
For j = i To lngGap + lngTop Step -lngGap
If vntList(j - lngGap, 1) <= vntTmp(0) Then
Exit For
End If
vntList(j, 1) = vntList(j - lngGap, 1)
vntList(j, 2) = vntList(j - lngGap, 2)
Next j
vntList(j, 1) = vntTmp(0)
vntList(j, 2) = vntTmp(1)
Next i
lngGap = lngGap \ 3
Loop
End Sub
|
|
- 03/6/26(木) 21:10 -
