Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


74802 / 76732 ←次へ | 前へ→

【6386】Re:効率的なマクロを教えてください
回答  Hirofumi E-MAIL  - 03/6/26(木) 21:10 -

引用なし
パスワード
   効率的では無いかも知れませんが、こんな物かな?
余り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名を1つづつ取り出す
  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
1 hits

【6379】効率的なマクロを教えてください ミルクティ 03/6/26(木) 16:32 質問
【6380】SUMIF関数では? wizard 03/6/26(木) 17:00 回答
【6382】Re:SUMIF関数では? ミルクティ 03/6/26(木) 17:17 回答
【6386】Re:効率的なマクロを教えてください Hirofumi 03/6/26(木) 21:10 回答
【6387】書き忘れました Hirofumi 03/6/26(木) 21:22 発言
【6391】Re:効率的なマクロを教えてください ミルクティ 03/6/27(金) 10:00 お礼

74802 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free