|
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
'--------------------------------------------------------
煮詰まってしまっている私です。
どうか…よろしくお願いします
|
|