Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
沢山のシートに分かれたデータを名称毎に集計したい
投稿日時: 18/05/15 21:31:37
投稿者: mattuwan44

いつもすみません。
 
30〜50位のシートにそれぞれデータを入力しています。
各シートのデータ数は1〜30くらいです。
データの項目は、
費目    名称    規格    単位    数量    単価    金額    取引先    摘要
です。
費目、名称、規格、単位、単価、取引先は重複するものがあります。
これらの同じデータは数量及び金額を合計したいです。
で、1つのシートに集計して纏めたいです。
 
データの入力をしながらの開発で、テンパって考えがまとまりません。
こういう時はやはりディクショナリーですかね?
 
でぃくしょなりーはこれまで避けて通っているので勉強する時間がもったいない気もしますが、
とりあえず、開発が比較的簡単にできる集計の方法論をアドバイスいただけないでしょうか?
 
 
 
 

回答
投稿日時: 18/05/15 21:50:19
投稿者: WinArrow
投稿者のウェブサイトに移動

まず、データを1つのシートに集約(コピペレベル)することです。
 
その後、集計キー項目で、並べ替えします。
 
「データ」タブの中の「小計」コマンドを使って集計します。
 
VBAに頼ることなく手操作でもできますよ。

投稿日時: 18/05/15 22:00:42
投稿者: mattuwan44

あぁ、小計機能がありましたね^^
 
とりあえず、手動で凌ぎます。
 
ありがとうございます。
 
引き続き、その他の方法論があればアドバイスいただけるとありがたいです。
 
いずれはアプリの一機能として追加したいです。
 
この際だから、dictionaryも探ってみますかねー^^;
 

回答
投稿日時: 18/05/15 22:17:04
投稿者: sy

統合も使えそうですね。
 
全てのシートを選択
A列に1列挿入
必要な列の文字を連結させて、最大行数分下にオートフィル
全シート最大行数で追加登録
上端行、左端列にチェックを入れて統合
統合後におそらく出来てる、途中の空白行1行を削除
 
こんな手順なら、今作るのに5シートで1分もかからなかったので、50シートでもそんなに手間では無さそうな気がします。
 

投稿日時: 18/05/15 22:22:06
投稿者: mattuwan44

ふー^^;
 
とりあえず、手動で纏めました^^;;
 
ほとんど1行しかデータがなかった><(何でこんな仕様にしたんだろう><)
 
 
ほー統合ですか。
使ったことないので、ちょっと試してみます。

回答
投稿日時: 18/05/15 22:47:11
投稿者: sy

あっ、なんかあり得ないくらい物凄くボケた回答してました。
 
統合では左端の連結した文字しか転記されないから、後から分割しないといけないのに、酒飲んでて気付いてませんでした。
 
金額と数量以外の全ての列を、間にセパレート文字を挟んで文字連結して、統合後に文字を分割して体裁を整える必要がありました。
 
いい加減な回答してしまい、大変申し訳ありません。
 
 

投稿日時: 18/05/15 22:55:54
投稿者: mattuwan44

>金額と数量以外の全ての列を、間にセパレート文字を挟んで文字連結して、
>統合後に文字を分割して体裁を整える必要がありました。
 
ありがとうございます。
やってみて気づいたのでやり直しました^^
 
手動のコピペだとやっぱミスがありますね。
手動でやったものと、統合を使ったものとチェックしたら、5件くらいデータの欠落が見つかったので、
助かりました^^
 
今日は、手が痛くなったので(マウス操作で腱鞘炎かなぁ^^;)、
これにて終了します。
 
明日以降も何かアイデアがあれば参考にしたいので、よろしくお願いします。

回答
投稿日時: 18/05/15 23:21:01
投稿者: WinArrow
投稿者のウェブサイトに移動

沢山のシートのデータを1つのシートに単純にコピペするマクロを紹介
※全てのデザインが同じであるという前提で・・・
※1行目が項目名である場合も、コピペされてしまうので、並べ替え後に削除するなど対応が必要かも
 
Sub シートデータ集約()
Dim NewSht As Worksheet
Dim sht As Worksheet
 
    With ActiveWorkbook
        .Sheets.Add after:=.Sheets(.Sheets.Count)
        Set NewSht = ActiveSheet
        NewSht.Name = "集約"
         
        For Each sht In .Sheets
            If sht.Name <> NewSht.Name Then
                sht.UsedRange.Copy Destination:=NewSht.Range("A" & NewSht.Rows.Count).End(xlUp).Offset(1)
            End If
        Next
    End With
End Sub
 

投稿日時: 18/05/16 14:37:20
投稿者: mattuwan44

うぅ、寝ぼけてました。
合計しなくてもシートを1つに集約するだけで良かったです。
お騒がせしましたm(_ _)m
 
ありがとうございました。
 
Sub リソース予算()
    Dim FName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ixRow As Long
    Dim wsMe As Worksheet
    Dim rngData As Range
 
    FName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
    If FName = "False" Then Exit Sub
    Set wb = Workbooks.Open(FName)
    Set wsMe = ThisWorkbook.Worksheets("リソース予算")
     
    wsMe.UsedRange.Offset(1).ClearContents
    ixRow = 2
    For Each ws In wb.Worksheets
        If ws.Name <> "工事費集計表" And _
           ws.Name <> "作業単価内訳書" Then
            With ws.UsedRange
                Set rngData = Intersect(.Cells, .Offset(2))
            End With
            If Not rngData Is Nothing Then
                rngData.Copy
                wsMe.Cells(ixRow, 2).PasteSpecial xlPasteValues
                wsMe.Cells(ixRow, 1).Resize(rngData.Rows.Count, 1).Value = ws.Name
                ixRow = ixRow + rngData.Rows.Count
            End If
        End If
    Next
    wb.Close False
End Sub