Excel VBA質問箱 IV

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

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


13240 / 13644 ツリー ←次へ | 前へ→

【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 お礼

【6379】効率的なマクロを教えてください
質問  ミルクティ  - 03/6/26(木) 16:32 -

引用なし
パスワード
   皆さん、初めまして。VBA初心者です。

やりたい事は
A列   B列   
Acc97   6   Acc  合計
Acc98  11   Ex   合計
Ex95   2   Offce  5
Acc2000 5  → WRD   8
Ex97   8
OffCE  5
WRD95  8

左のようなデータを右のようなフォーマットにしたいのです。
毎日の業務なのですが、左のA列の順番はその日によって違います。
右のフォーマットは決まっています。
ただ、転記するのではなく項目ごとに合計記入しないといけません。
例えば、Accが含まれてるものが複数ある場合はB列を合計して(上記の場合は
6+11+5をAccの合計に入れる)フォーマットに記入しなければなりません。

行数は100行くらいです。
私の頭ではフォーマットの項目を上から順に検索して引っかかったセルの数字を
フォーマットにいれて、また検索してという(for〜nextとIF)方法しか思いつきません。何かいい方法があれば教えてください。よろしくお願いいたします(*--)(*__)

【6380】SUMIF関数では?
回答  wizard  - 03/6/26(木) 17:00 -

引用なし
パスワード
   ミルクティさん、こんにちは。
SUMIF関数で
Acc合計のセルには、=SUMIF($A$2:$A$8,"=Acc*",$B$2:$B$8)
Ex合計のセルには、=SUMIF($A$2:$A$8,"=Ex*",$B$2:$B$8)
(セル参照範囲は変更してね)
ではダメでしょうか?

【6382】Re:SUMIF関数では?
回答  ミルクティ  - 03/6/26(木) 17:17 -

引用なし
パスワード
   早速のお返事ありがとうございます。
説明が足りなくて非常に申し訳ないのですが、
左はログのファイルで右はフォーマットのファイルなので
ファイルが別なのです。いけますでしょうか?

とりあえず、ログのどっかに数字を並べて(フォーマットの順番に)
マクロで転記だけとかだったらいけますかね。

【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

【6387】書き忘れました
発言  Hirofumi E-MAIL  - 03/6/26(木) 21:22 -

引用なし
パスワード
   書き忘れました
集計用シートのA列には、Acc、Ex、Offce等のグループの名前が入っている必要が有ります
これは、データの中にこの文字列が有るかどうかの比較の為に使用します

【6391】Re:効率的なマクロを教えてください
お礼  ミルクティ  - 03/6/27(金) 10:00 -

引用なし
パスワード
   Hirofumi さん、レスが遅くなり申し訳ございませんでした。

ご親切にマクロまで書いていただきありがとうございます。
私の説明が不足しているのが駄目なんですが、Acc**→Accになるわけではないのです。
Acc**→Acc○○数になります。

Hirofumiさんの丁寧なマクロをみて少し自分で考えてみます。配列の使い方が全く
忘れてしまっていたので、Hirofumiさんのを参考にやってみます。
ありがとうございました。

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