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

≪