Excel VBA質問箱 IV

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

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


24208 / 76732 ←次へ | 前へ→

【57874】データ集計の方法
質問  MIRURU  - 08/9/18(木) 16:06 -

引用なし
パスワード
   VBA初心者です。
何度、考えてもどうしても分からないので投稿させていただきました。
下記のような表があります。
シート名「data」の、項目の「NAME,BUDHO,CODE,TYPE」の4つが同じデータなら、項目「TIME」を合計して、シート名「data編集」に一行にまとめて、転記していく表を作成したいと考えております。

シート名「data」
DATE  | NAME | BUSHO | CODE | TYPE | TIME
-----------------------------------------------
08/08/01|tanaka |Seizou | A  | 1  | 2
08/08/01|yamada |Kensa | A  | 2  | 1
08/08/01|tanaka |Seizou | B  | 1  | 1
08/08/01|tanaka |Seizou | A  | 1  | 1
08/08/01|yamada |Kensa | A  | 2  | 2

↓処理後・・・
シート名「data編集」
DATE  | NAME | BUSHO | CODE | TYPE | TIME
-----------------------------------------------
08/08/01|tanaka |Seizou | A  | 1  | 3
08/08/01|yamada |Kensa | A  | 2  | 3
08/08/01|tanaka |Seizou | B  | 1  | 1

下記のようなコードを作成してみました。
Sub data編集()

Dim MaxR As Integer
Dim LastR As Integer
Dim Mydate As Date
Dim Name As Variant
Dim Busho As Variant
Dim Code As Variant
Dim Type As Variant
Dim MyTime As Variant
Dim WName As Range
Dim WBusho As Range
Dim WCode As Range
Dim WType As Range
Dim MyR As Integer


Worksheets("data").Select
MaxR = Range("A65536").End(xlUp).Row - 1

For i = 1 To MaxR
Mydate = Cells(i + 1, 1).Value
Name = Cells(i + 1, 2).Value
Busho = Cells(i + 1, 3).Value
Code = Cells(i + 1, 4).Value
Type = Cells(i + 1, 5).Value
Kousu = Cells(i + 1, 6).Value

Worksheets("data編集").Activate
LastR = Range("A65536").End(xlUp).Row

'Find検索は必要ない??ですか?

Set WName = Range(Cells(2, 2), Cells(LastR, 2)).Find(what:=Name, lookat:=xlWhole)
Set WBusho = Range(Cells(2, 3), Cells(LastR, 3)).Find(what:=Busho, lookat:=xlWhole)
Set WCode = Range(Cells(2, 4), Cells(LastR, 4)).Find(what:=Code, lookat:=xlWhole)
Set WType = Range(Cells(2, 5), Cells(LastR, 5)).Find(what:=Type, lookat:=xlWhole)

For q = 1 To LastR - 1

If Range("B" & q + 1).Value = Name And Range("C" & q + 1).Value = Busho And Range("D" & q + 1).Value = Code And Range("E" & q + 1).Value = Type Then

Range("B" & q + 1).Select
MyR = ActiveCell.Select
Range("B" & q + 1).Offset(0, 4).Value = Kousu + Range("B" & q + 1).Offset(0, 4).Value

Worksheets("data").Select
Exit For

End If

Next q
'この辺から、どう処理するコードを書けばよいのか…わからなくなってしまいました。
’↓
'重複しているデータがあれば、「Time」を合計して、一行にまとめ、なければ、最終行にデータを転記していく…という方法を知りたいです。

Worksheets("data編集").Select

Cells(LastR + 1, 1).Value = Mydate
Cells(LastR + 1, 2).Value = Name
Cells(LastR + 1, 3).Value = Busho
Cells(LastR + 1, 4).Value = Code
Cells(LastR + 1, 5).Value = Type
Cells(LastR + 1, 6).Value = Kousu

Worksheets("data").Select
Next i

End Sub
'--------------------------------------------------------
煮詰まってしまっている私です。
どうか…よろしくお願いします

 
0 hits

【57874】データ集計の方法 MIRURU 08/9/18(木) 16:06 質問
【57876】Re:データ集計の方法 kanabun 08/9/18(木) 16:52 発言
【57878】Re:データ集計の方法 Hirofumi 08/9/18(木) 20:08 回答
【57880】Re:データ集計の方法 kanabun 08/9/18(木) 21:47 発言
【57881】Re:データ集計の方法 kanabun 08/9/18(木) 21:59 発言
【57937】Re:データ集計の方法 MIRURU 08/9/22(月) 11:30 お礼

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