過去ログ

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ     837
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　▼データ抽出について  ＴＫ 03/3/5(水) 13:36
　　　┗Re:データ抽出について  ぴかる 03/3/5(水) 14:02
　　　　　　┣Re:データ抽出について  ＴＫ 03/3/5(水) 14:16
　　　　　　┗Re:データ抽出について  ＴＫ 03/3/5(水) 14:29
　　　　　　　　　┗すんません！  ぴかる 03/3/5(水) 14:58
　　　　　　　　　　　　┗Re:すんません！  ＴＫ 03/3/5(水) 15:14
　　　　　　　　　　　　　　　┣Re:上手く無いけど  Hirofumi 03/3/5(水) 21:51
　　　　　　　　　　　　　　　┃　　┣Re:上手く無いけど  ichinose 03/3/5(水) 22:43
　　　　　　　　　　　　　　　┃　　┃　　┗Re:上手く無いけど  ＴＫ 03/3/6(木) 0:05
　　　　　　　　　　　　　　　┃　　┗Re:上手く無いけど  ＴＫ 03/3/6(木) 0:02
　　　　　　　　　　　　　　　┗フォローありがとうございました。  ぴかる 03/3/6(木) 9:02
　　　　　　　　　　　　　　　　　　┗解決済みのようですが、せっかくなので...  こう 03/3/6(木) 13:16

　───────────────────────────────────────
　■題名 ： データ抽出について
　■名前 ： ＴＫ
　■日付 ： 03/3/5(水) 13:36
　-------------------------------------------------------------------------
   
お世話になります。

この場で質問するには恐縮するのですが、

以下の点で困ってます。

いつもですと、スキルを持った人がおられて

対応できるのですが、急な依頼により私が対応

することになりました。

素人ですが宜しくお願いします。



（データ：エクセル、シート：sheet1）



日付　　　　品名　　　　色　　　　金額

030301　　　　A　　　　K　　　　1000

030301　　　　A　　　　K　　　　1200

030301　　　　A　　　　K　　　　1400

030302　　　　A　　　　K　　　　1250

030302　　　　B　　　　S　　　　900

030302　　　　B　　　　S　　　　750

030304　　　　B　　　　S　　　　1450

030305　　　　C　　　　L　　　　7580

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

030314　　　　Z　　　　X　　　　450



上記データの中で品名と色が同じ物の最初の日付１と

最後の日付２のデータを別ｼｰﾄ(sheet2)へ抽出したい。

その際、金額は総計金額としたい



日付1　　　　日付2　　　　品名　　　　色　　　　総計金額

030301　　　　030302　　　　A　　　　K　　　　4850

030302　　　　030304　　　　B　　　　S　　　　3100

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・



宜しくご教授お願い致します。


　───────────────────────────────────────
　■題名 ： Re:データ抽出について
　■名前 ： ぴかる
　■日付 ： 03/3/5(水) 14:02
　-------------------------------------------------------------------------
   
ＴＫさん、こんにちは。



>日付1　　　　日付2　　　　品名　　　　色　　　　総計金額

>030301　　　　030302　　　　A　　　　K　　　　4850

>030302　　　　030304　　　　B　　　　S　　　　3100

ＶＢＡではなく、データベース関数で可能と思います。

　日付1 … DMIN

　日付2 … DMAX

　総計金額 … DSUM

ちょっとややこしい関数です。ヘルプ等で確認して下さい。


　───────────────────────────────────────
　■題名 ： Re:データ抽出について
　■名前 ： ＴＫ
　■日付 ： 03/3/5(水) 14:16
　-------------------------------------------------------------------------
   
▼ぴかる さん：

どうも早速の返答ありがとうございました。



>　日付1 … DMIN

>　日付2 … DMAX

>　総計金額 … DSUM

>ちょっとややこしい関数です。ヘルプ等で確認して下さい。



エクセルベースで行ってみたいと思います。


　───────────────────────────────────────
　■題名 ： Re:データ抽出について
　■名前 ： ＴＫ
　■日付 ： 03/3/5(水) 14:29
　-------------------------------------------------------------------------
   
▼ぴかる さん

Ｔｋです。



早速エクセルの関数で行おうと思ったのですが、私の言葉不足だったのですが、

ﾛｯﾄ単位での集計を行いたいのです。

つまり、以下の様なケースの場合、エクセル関数では難しそうなのですが・・・。



日付　　　　品名　　　　色　　　　金額

030301　　　　A　　　　K　　　　1000

030301　　　　A　　　　K　　　　1200

030301　　　　A　　　　K　　　　1400

030302　　　　A　　　　K　　　　1250

030302　　　　B　　　　S　　　　900

030302　　　　B　　　　S　　　　750

030304　　　　B　　　　S　　　　1450

030305　　　　C　　　　L　　　　7580

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

030314　　　　Z　　　　X　　　　450

030401　　　　A　　　　K　　　　1200

030402　　　　A　　　　K　　　　1150

030403　　　　B　　　　S　　　　980

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

030506　　　　A　　　　K　　　　1180

030507　　　　A　　　　K　　　　1200

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

上記の場合、ﾛｯﾄ単位とは以下のようになります。



日付1　　　　日付2　　　　品名　　　　色　　　　総計金額

030301　　　　030302　　　　A　　　　K　　　　4850

030302　　　　030304　　　　B　　　　S　　　　3100

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

030401　　　　030402　　　　A　　　　K　　　　2300

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・

030506　　　　030507　　　　A　　　　K　　　　1380

　・　　　　・　　　　・　　　　・

　・　　　　・　　　　・　　　　・



ﾛｯﾄとは、最上記表での連続したデータを日付で昇順にならべてあります。

その場合、品名と色とが連続的に続いたブロックをﾛｯﾄとしてます。



私の行いたいことの説明不足で申し訳有りませんが、宜しくお願いします。


　───────────────────────────────────────
　■題名 ： すんません！
　■名前 ： ぴかる
　■日付 ： 03/3/5(水) 14:58
　-------------------------------------------------------------------------
   
すんません！。日常業務もありまして本日中は、無理と思います。

ロットの意味も分かりました。時間が取れないのが残念です。

繰り返し文と条件分岐で可能とは思いますが・・・。

ていうことでどなたかお願い出来ませんか？。よろしくお願い致します。


　───────────────────────────────────────
　■題名 ： Re:すんません！
　■名前 ： ＴＫ
　■日付 ： 03/3/5(水) 15:14
　-------------------------------------------------------------------------
   
▼ぴかる さん：

ＴＫです。

ぴかるさん　お気遣いどうもありがとうございます。

また、みなさんどうかご教授ねがいます。

宜しくお願いします。



>すんません！。日常業務もありまして本日中は、無理と思います。

>ロットの意味も分かりました。時間が取れないのが残念です。

>繰り返し文と条件分岐で可能とは思いますが・・・。

>ていうことでどなたかお願い出来ませんか？。よろしくお願い致します。


　───────────────────────────────────────
　■題名 ： Re:上手く無いけど
　■名前 ： Hirofumi <hirofumi@venus.dti.ne.jp>
　■日付 ： 03/3/5(水) 21:51
　-------------------------------------------------------------------------
   
なんか、スッキリ纏まらなくて気に入らないけれど

こんなもんかな？



Public Sub AddUp()



　　Dim i As Long

　　Dim j As Long

　　Dim vntData As Variant

　　Dim vntAdd(4) As Variant

　　Dim lngDataTop As Long

　　Dim lngDataEnd As Long

　　Dim lngListTop As Long

　　Dim lngListEnd As Long

　　Dim wksData As Worksheet

　　Dim wksAdd As Worksheet



　　Set wksData = Worksheets("sheet1")

　　With wksData

　　　　lngDataTop = 2

　　　　lngDataEnd = .Cells(65536, 1).End(xlUp).Row

　　End With

　　Set wksAdd = Worksheets("sheet2")

　　With wksAdd

　　　　lngListTop = 2

　　　　lngListEnd = .Cells(65536, 1).End(xlUp).Row

　　End With

　　

　　'Listを作成

　　i = lngDataTop

　　With wksData.Cells(i, 1)

　　　　vntData = Range(.Offset(, 0), .Offset(, 3)).Value

　　End With

　　vntAdd(0) = vntData(1, 1)

　　For j = 1 To 4

　　　　vntAdd(j) = vntData(1, j)

　　Next j

　　i = i + 1

　　'データの最終まで繰り返し

　　Do Until i > lngDataEnd

　　　　With wksData.Cells(i, 1)

　　　　　　vntData = Range(.Offset(, 0), .Offset(, 3)).Value

　　　　End With

　　　　'もし、データの品名、色が集計配列のそれと同じなら

　　　　If vntData(1, 2) = vntAdd(2) _

　　　　　　　　　　　　And vntData(1, 3) = vntAdd(3) Then

　　　　　　'集計配列の２番に日付を代入

　　　　　　vntAdd(1) = vntData(1, 1)

　　　　　　'集計配列の４番にデータの金額を加算

　　　　　　vntAdd(4) = vntAdd(4) + vntData(1, 4)

　　　　Else

　　　　　　'集計シートの最終行を更新

　　　　　　lngListEnd = lngListEnd + 1

　　　　　　With wksAdd.Cells(lngListEnd, 1)

　　　　　　　　'書き込み行のA、B列の書式を文字に設定

　　　　　　　　Range(.Offset(, 0), .Offset(, 1)).NumberFormatLocal = "@"

　　　　　　　　'書き込み行に集計配列を代入

　　　　　　　　Range(.Offset(, 0), .Offset(, 4)).Value = vntAdd

　　　　　　End With

　　　　　　vntAdd(0) = vntData(1, 1)

　　　　　　For j = 1 To 4

　　　　　　　　vntAdd(j) = vntData(1, j)

　　　　　　Next j

　　　　End If

　　　　'データ用カウンタを更新

　　　　i = i + 1

　　Loop

　　lngListEnd = lngListEnd + 1

　　With wksAdd.Cells(lngListEnd, 1)

　　　　'書き込み行のA、B列の書式を文字に設定

　　　　Range(.Offset(, 0), .Offset(, 1)).NumberFormatLocal = "@"

　　　　'書き込み行に集計配列を代入

　　　　Range(.Offset(, 0), .Offset(, 4)).Value = vntAdd

　　End With

　　

　　Set wksData = Nothing

　　Set wksAdd = Nothing



End Sub


　───────────────────────────────────────
　■題名 ： Re:上手く無いけど
　■名前 ： ichinose
　■日付 ： 03/3/5(水) 22:43
　-------------------------------------------------------------------------
   
みなさん、こんばんは。

回答されているようですが､作っちゃったんで掲載させてください。

Sheet1のＥ列とＦ列を作業領域として使用しています。

Ｅ列Ｆ列も使用しているなら、別の列でもかまいませんが､

Offsetで参照していますのでコードを変えなければなりません。

'=========================================================

Dim s2idx As Long 'sheet2の設定カレント行

'=========================================================

Sub test()

　　Dim v_yymm As Long '集計する年月

　　Dim v_max As Long　'集計する年月の上限

　　Dim rng1 As Range 'sheet1の日付が入っている範囲

　　Dim rng2 As Range 'ロット単位のsheet1の日付が入っている範囲

　　Dim rng3 As Range 'ロット単位のsheet1のユニークな品名

　　Dim rng4 As Range 'ロット単位のsheet1のユニークな色

　　If get_min_max(v_yymm, v_max, rng1) = True Then 'sheet1の日付の最大・最小及び、Ａ列のデータ範囲取得成功？

　　　 v_yymm = Val(Mid$(Format$(Str(v_yymm), "000000"), 1, 4)) '集計年月セット

　　　 v_max = Val(Mid$(Format$(Str(v_max), "000000"), 1, 4))　 '上限年月セット

　　　 s2idx = 2

　　　 Do While v_yymm <= v_max '集計する年月が上限以内ならループ

　　　　 If get_conbination(rng1, rng2, rng3, rng4, v_yymm) = True Then '品名と色の組み合わせを取得

　　　　　　Call 集計_proc(rng2, rng3, rng4) '集計処理

　　　　　　End If

　　　　 v_yymm = get_next_yymm(v_yymm) '次の年月取得

　　　　 Loop

　　　 If s2idx > 2 Then '集計データがあったら、数式を値に変換

　　　　　With Worksheets(2).Range("a2", Worksheets(2).Cells(s2idx, 5))

　　　　　　.Value = .Value

　　　　　　End With

　　　　　End If

　　　　　　

　　Else

　　　 MsgBox "集計データ不備"

　　　 End If

End Sub

'============================================================

Function get_next_yymm(yymm As Long)

'次の年月を取得する

　　Dim yymm_str As String

　　yymm_str = Format$(Str(yymm + 1), "0000")

　　If Val(Mid$(yymm_str, 3, 2)) = 13 Then

　　　 get_next_yymm = (Val(Mid$(yymm_str, 1, 2)) + 1) * 100 + 1

　　Else

　　　 get_next_yymm = Val(yymm_str)

　　　 End If

End Function

'==========================================================================

Function get_min_max(v_min As Long, v_max As Long, ar1 As Range) As Boolean

'日付範囲の取得

　　get_min_max = False

　　With Sheet1

　　　Set ar1 = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp))

　　　If ar1.Address = Range("a1").Address Then Exit Function

　　　Set ar1 = ar1.Offset(1, 0).Resize(ar1.Rows.Count - 1, 1)

　　　End With

　　v_min = WorksheetFunction.Min(ar1)

　　v_max = WorksheetFunction.Max(ar1)

　　If v_min > 0 And v_max > 0 Then

　　　 get_min_max = True

　　　 End If

End Function

'=========================================================================

Function get_conbination(ar1 As Range, ar2 As Range, ar3 As Range, ar4 As Range, yymm As Long) As Boolean

'品名と色の組み合わせを取得

　　get_conbination = False

　　With ar1

　　　.Offset(0, 4).FormulaR1C1 = "=if(and(r[0]c[-4]>=" & Format$(Str(yymm * 100 + 1), "000000") & ",r[0]c[-4]<=" & Format$(Str(yymm * 100 + 31), "000000") & ")=true,1,"""")"

　　　.Offset(0, 4).Value = .Offset(0, 4).Value

　　　Set ar2 = sp_rng(.Offset(0, 4))

　　　If Not ar2 Is Nothing Then

　　　　 ar2.Value = ""

　　　　 Set ar2 = ar2.Offset(0, -4)

　　　　 With ar2

　　　　　 .Offset(0, 4).Resize(, 2).FormulaR1C1 = "=IF(rc[-3]<>"""",IF(COUNTIF(r" & .Item(1).Row & "c[-3]:rc[-3],rc[-3])=1,1,""""),"""")"

　　　　　 .Offset(0, 4).Resize(, 2).Value = .Offset(0, 4).Resize(, 2).Value

　　　　　 Set ar3 = sp_rng(.Offset(0, 4))

　　　　　 Set ar4 = sp_rng(.Offset(0, 5))

　　　　　 End With

　　　　 If (Not ar3 Is Nothing) And (Not ar4 Is Nothing) Then

　　　　　　ar3.Value = ""

　　　　　　ar4.Value = ""

　　　　　　Set ar3 = ar3.Offset(0, -3)

　　　　　　Set ar4 = ar4.Offset(0, -3)

　　　　　　get_conbination = True

　　　　　　End If

　　　　 End If

　　　End With

End Function

'=======================================================================

Function sp_rng(rng As Range) As Range

'値が入っているセル範囲の取得

　　On Error Resume Next

　　Set sp_rng = rng.SpecialCells(xlCellTypeConstants)

　　If Err.Number <> 0 Then

　　　 Set sp_rng = Nothing

　　　 End If

　　On Error GoTo 0

End Function

'========================================================================

Sub 集計_proc(rng1 As Range, rng2 As Range, rng3 As Range)

'Sheet2への集計書き込み処理

　　Dim shtnm As String

　　Dim r2 As Range

　　Dim r3 As Range

　　shtnm = rng1.Parent.Name & "!"

　　With Sheet2

　　　For Each r2 In rng2

　　　　For Each r3 In rng3

　　　　　.Cells(s2idx, 5).FormulaArray = "=sum(if(" & shtnm & rng1.Offset(0, 1).Address & "=" & shtnm & r2.Address & ",if(" & _

　　　　　shtnm & rng1.Offset(0, 2).Address & "=" & shtnm & r3.Address & "," & shtnm & rng1.Offset(0, 3).Address & ",0),0))"

　　　　　If .Cells(s2idx, 5).Value <> 0 Then

　　　　　　 .Cells(s2idx, 1).FormulaArray = "=min(if(" & shtnm & rng1.Offset(0, 1).Address & "=" & shtnm & r2.Address & ",if(" & _

　　　　　　　 shtnm & rng1.Offset(0, 2).Address & "=" & shtnm & r3.Address & "," & shtnm & rng1.Address & ")))"

　　　　　　 .Cells(s2idx, 2).FormulaArray = "=max(if(" & shtnm & rng1.Offset(0, 1).Address & "=" & shtnm & r2.Address & ",if(" & _

　　　　　　　 shtnm & rng1.Offset(0, 2).Address & "=" & shtnm & r3.Address & "," & shtnm & rng1.Address & ")))"

　　　　　　 .Cells(s2idx, 3).Value = r2.Value

　　　　　　 .Cells(s2idx, 4).Value = r3.Value

　　　　　　 s2idx = s2idx + 1

　　　　　　 End If

　　　　　Next

　　　　Next

　　　End With

End Sub


　───────────────────────────────────────
　■題名 ： Re:上手く無いけど
　■名前 ： ＴＫ
　■日付 ： 03/3/6(木) 0:05
　-------------------------------------------------------------------------
   
▼ichinose さん：

こんばんは。ＴＫです。



>みなさん、こんばんは。

>回答されているようですが､作っちゃったんで掲載させてください。

>Sheet1のＥ列とＦ列を作業領域として使用しています。

>Ｅ列Ｆ列も使用しているなら、別の列でもかまいませんが､

>Offsetで参照していますのでコードを変えなければなりません。



大変ありがたくおもいます。

これを機に勉強したいと思いますので、今後ともよろしくお願いします。





>'=========================================================

>Dim s2idx As Long 'sheet2の設定カレント行

>'=========================================================

>Sub test()

>　　Dim v_yymm As Long '集計する年月

>　　Dim v_max As Long　'集計する年月の上限

>　　Dim rng1 As Range 'sheet1の日付が入っている範囲

>　　Dim rng2 As Range 'ロット単位のsheet1の日付が入っている範囲

>　　Dim rng3 As Range 'ロット単位のsheet1のユニークな品名

>　　Dim rng4 As Range 'ロット単位のsheet1のユニークな色

>　　If get_min_max(v_yymm, v_max, rng1) = True Then 'sheet1の日付の最大・最小及び、Ａ列のデータ範囲取得成功？

>　　　 v_yymm = Val(Mid$(Format$(Str(v_yymm), "000000"), 1, 4)) '集計年月セット

>　　　 v_max = Val(Mid$(Format$(Str(v_max), "000000"), 1, 4))　 '上限年月セット

>　　　 s2idx = 2

>　　　 Do While v_yymm <= v_max '集計する年月が上限以内ならループ

>　　　　 If get_conbination(rng1, rng2, rng3, rng4, v_yymm) = True Then '品名と色の組み合わせを取得

>　　　　　　Call 集計_proc(rng2, rng3, rng4) '集計処理

>　　　　　　End If

>　　　　 v_yymm = get_next_yymm(v_yymm) '次の年月取得

>　　　　 Loop

>　　　 If s2idx > 2 Then '集計データがあったら、数式を値に変換

>　　　　　With Worksheets(2).Range("a2", Worksheets(2).Cells(s2idx, 5))

>　　　　　　.Value = .Value

>　　　　　　End With

>　　　　　End If

>　　　　　　

>　　Else

>　　　 MsgBox "集計データ不備"

>　　　 End If

>End Sub

>'============================================================

>Function get_next_yymm(yymm As Long)

>'次の年月を取得する

>　　Dim yymm_str As String

>　　yymm_str = Format$(Str(yymm + 1), "0000")

>　　If Val(Mid$(yymm_str, 3, 2)) = 13 Then

>　　　 get_next_yymm = (Val(Mid$(yymm_str, 1, 2)) + 1) * 100 + 1

>　　Else

>　　　 get_next_yymm = Val(yymm_str)

>　　　 End If

>End Function

>'==========================================================================

>Function get_min_max(v_min As Long, v_max As Long, ar1 As Range) As Boolean

>'日付範囲の取得

>　　get_min_max = False

>　　With Sheet1

>　　　Set ar1 = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp))

>　　　If ar1.Address = Range("a1").Address Then Exit Function

>　　　Set ar1 = ar1.Offset(1, 0).Resize(ar1.Rows.Count - 1, 1)

>　　　End With

>　　v_min = WorksheetFunction.Min(ar1)

>　　v_max = WorksheetFunction.Max(ar1)

>　　If v_min > 0 And v_max > 0 Then

>　　　 get_min_max = True

>　　　 End If

>End Function

>'=========================================================================

>Function get_conbination(ar1 As Range, ar2 As Range, ar3 As Range, ar4 As Range, yymm As Long) As Boolean

>'品名と色の組み合わせを取得

>　　get_conbination = False

>　　With ar1

>　　　.Offset(0, 4).FormulaR1C1 = "=if(and(r[0]c[-4]>=" & Format$(Str(yymm * 100 + 1), "000000") & ",r[0]c[-4]<=" & Format$(Str(yymm * 100 + 31), "000000") & ")=true,1,"""")"

>　　　.Offset(0, 4).Value = .Offset(0, 4).Value

>　　　Set ar2 = sp_rng(.Offset(0, 4))

>　　　If Not ar2 Is Nothing Then

>　　　　 ar2.Value = ""

>　　　　 Set ar2 = ar2.Offset(0, -4)

>　　　　 With ar2

>　　　　　 .Offset(0, 4).Resize(, 2).FormulaR1C1 = "=IF(rc[-3]<>"""",IF(COUNTIF(r" & .Item(1).Row & "c[-3]:rc[-3],rc[-3])=1,1,""""),"""")"

>　　　　　 .Offset(0, 4).Resize(, 2).Value = .Offset(0, 4).Resize(, 2).Value

>　　　　　 Set ar3 = sp_rng(.Offset(0, 4))

>　　　　　 Set ar4 = sp_rng(.Offset(0, 5))

>　　　　　 End With

>　　　　 If (Not ar3 Is Nothing) And (Not ar4 Is Nothing) Then

>　　　　　　ar3.Value = ""

>　　　　　　ar4.Value = ""

>　　　　　　Set ar3 = ar3.Offset(0, -3)

>　　　　　　Set ar4 = ar4.Offset(0, -3)

>　　　　　　get_conbination = True

>　　　　　　End If

>　　　　 End If

>　　　End With

>End Function

>'=======================================================================

>Function sp_rng(rng As Range) As Range

>'値が入っているセル範囲の取得

>　　On Error Resume Next

>　　Set sp_rng = rng.SpecialCells(xlCellTypeConstants)

>　　If Err.Number <> 0 Then

>　　　 Set sp_rng = Nothing

>　　　 End If

>　　On Error GoTo 0

>End Function

>'========================================================================

>Sub 集計_proc(rng1 As Range, rng2 As Range, rng3 As Range)

>'Sheet2への集計書き込み処理

>　　Dim shtnm As String

>　　Dim r2 As Range

>　　Dim r3 As Range

>　　shtnm = rng1.Parent.Name & "!"

>　　With Sheet2

>　　　For Each r2 In rng2

>　　　　For Each r3 In rng3

>　　　　　.Cells(s2idx, 5).FormulaArray = "=sum(if(" & shtnm & rng1.Offset(0, 1).Address & "=" & shtnm & r2.Address & ",if(" & _

>　　　　　shtnm & rng1.Offset(0, 2).Address & "=" & shtnm & r3.Address & "," & shtnm & rng1.Offset(0, 3).Address & ",0),0))"

>　　　　　If .Cells(s2idx, 5).Value <> 0 Then

>　　　　　　 .Cells(s2idx, 1).FormulaArray = "=min(if(" & shtnm & rng1.Offset(0, 1).Address & "=" & shtnm & r2.Address & ",if(" & _

>　　　　　　　 shtnm & rng1.Offset(0, 2).Address & "=" & shtnm & r3.Address & "," & shtnm & rng1.Address & ")))"

>　　　　　　 .Cells(s2idx, 2).FormulaArray = "=max(if(" & shtnm & rng1.Offset(0, 1).Address & "=" & shtnm & r2.Address & ",if(" & _

>　　　　　　　 shtnm & rng1.Offset(0, 2).Address & "=" & shtnm & r3.Address & "," & shtnm & rng1.Address & ")))"

>　　　　　　 .Cells(s2idx, 3).Value = r2.Value

>　　　　　　 .Cells(s2idx, 4).Value = r3.Value

>　　　　　　 s2idx = s2idx + 1

>　　　　　　 End If

>　　　　　Next

>　　　　Next

>　　　End With

>End Sub


　───────────────────────────────────────
　■題名 ： Re:上手く無いけど
　■名前 ： ＴＫ
　■日付 ： 03/3/6(木) 0:02
　-------------------------------------------------------------------------
   
▼Hirofumi さん：

Ｔｋです。どうもありがとうございました。

早速使用させていただきます。

これからもよろしくお願いします。

お礼まで・・・・。



>なんか、スッキリ纏まらなくて気に入らないけれど

>こんなもんかな？

>

>Public Sub AddUp()

>

>　　Dim i As Long

>　　Dim j As Long

>　　Dim vntData As Variant

>　　Dim vntAdd(4) As Variant

>　　Dim lngDataTop As Long

>　　Dim lngDataEnd As Long

>　　Dim lngListTop As Long

>　　Dim lngListEnd As Long

>　　Dim wksData As Worksheet

>　　Dim wksAdd As Worksheet

>

>　　Set wksData = Worksheets("sheet1")

>　　With wksData

>　　　　lngDataTop = 2

>　　　　lngDataEnd = .Cells(65536, 1).End(xlUp).Row

>　　End With

>　　Set wksAdd = Worksheets("sheet2")

>　　With wksAdd

>　　　　lngListTop = 2

>　　　　lngListEnd = .Cells(65536, 1).End(xlUp).Row

>　　End With

>　　

>　　'Listを作成

>　　i = lngDataTop

>　　With wksData.Cells(i, 1)

>　　　　vntData = Range(.Offset(, 0), .Offset(, 3)).Value

>　　End With

>　　vntAdd(0) = vntData(1, 1)

>　　For j = 1 To 4

>　　　　vntAdd(j) = vntData(1, j)

>　　Next j

>　　i = i + 1

>　　'データの最終まで繰り返し

>　　Do Until i > lngDataEnd

>　　　　With wksData.Cells(i, 1)

>　　　　　　vntData = Range(.Offset(, 0), .Offset(, 3)).Value

>　　　　End With

>　　　　'もし、データの品名、色が集計配列のそれと同じなら

>　　　　If vntData(1, 2) = vntAdd(2) _

>　　　　　　　　　　　　And vntData(1, 3) = vntAdd(3) Then

>　　　　　　'集計配列の２番に日付を代入

>　　　　　　vntAdd(1) = vntData(1, 1)

>　　　　　　'集計配列の４番にデータの金額を加算

>　　　　　　vntAdd(4) = vntAdd(4) + vntData(1, 4)

>　　　　Else

>　　　　　　'集計シートの最終行を更新

>　　　　　　lngListEnd = lngListEnd + 1

>　　　　　　With wksAdd.Cells(lngListEnd, 1)

>　　　　　　　　'書き込み行のA、B列の書式を文字に設定

>　　　　　　　　Range(.Offset(, 0), .Offset(, 1)).NumberFormatLocal = "@"

>　　　　　　　　'書き込み行に集計配列を代入

>　　　　　　　　Range(.Offset(, 0), .Offset(, 4)).Value = vntAdd

>　　　　　　End With

>　　　　　　vntAdd(0) = vntData(1, 1)

>　　　　　　For j = 1 To 4

>　　　　　　　　vntAdd(j) = vntData(1, j)

>　　　　　　Next j

>　　　　End If

>　　　　'データ用カウンタを更新

>　　　　i = i + 1

>　　Loop

>　　lngListEnd = lngListEnd + 1

>　　With wksAdd.Cells(lngListEnd, 1)

>　　　　'書き込み行のA、B列の書式を文字に設定

>　　　　Range(.Offset(, 0), .Offset(, 1)).NumberFormatLocal = "@"

>　　　　'書き込み行に集計配列を代入

>　　　　Range(.Offset(, 0), .Offset(, 4)).Value = vntAdd

>　　End With

>　　

>　　Set wksData = Nothing

>　　Set wksAdd = Nothing

>

>End Sub


　───────────────────────────────────────
　■題名 ： フォローありがとうございました。
　■名前 ： ぴかる
　■日付 ： 03/3/6(木) 9:02
　-------------------------------------------------------------------------
   
おはようございます。



Hirofumiさん、ichinoseさん、フォロー誠にありがとうございました。

ichinoseさん、毎回毎回ほんまに助かります。

次回のヘルプコール（多分あると思います。）の時も、よろしくよろしくです。


　───────────────────────────────────────
　■題名 ： 解決済みのようですが、せっかくなので...
　■名前 ： こう <kou__@anet.ne.jp>
　■日付 ： 03/3/6(木) 13:16
　-------------------------------------------------------------------------
   
#しかもベタロジックです。^^;



少ないステップ数ですのでご参考まで。

上から参照していき品名と色が異なれば開始日、終了日、総計金額を表示します。



　　With Worksheets(1).UsedRange

　　　　LastRow = .Rows(.Rows.Count).Row

　　End With

　　With Worksheets(1)

　　　　日付 = "": 品名 = "": 色 = "": 総計金額 = 0

　　　　j = 2

　　　　For i = 2 To LastRow

　　　　　　If 日付 = "" Then

　　　　　　　　開始日 = .Cells(i, 1)

　　　　　　　　日付 = .Cells(i, 1)

　　　　　　　　品名 = .Cells(i, 2)

　　　　　　　　色 = .Cells(i, 3)

　　　　　　　　総計金額 = 0

　　　　　　End If

　　　　　　If .Cells(i + 1, 2) = 品名 And .Cells(i + 1, 3) = 色 Then

　　　　　　　　総計金額 = 総計金額 + .Cells(i, 4)

　　　　　　Else

　　　　　　　　Cells(j, 1) = 開始日

　　　　　　　　Cells(j, 2) = .Cells(i, 1)

　　　　　　　　Cells(j, 3) = 品名

　　　　　　　　Cells(j, 4) = 色

　　　　　　　　Cells(j, 5) = 総計金額 + .Cells(i, 4)

　　　　　　　　日付 = ""

　　　　　　　　j = j + 1 'sheet2の行カウンタ1UP

　　　　　　End If

　　　　Next

　　End With

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　通常モードに戻る　　┃　　ＩＮＤＥＸ　　┃　　≪前へ　　│　　次へ≫　　　
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　Ｐａｇｅ     837