[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『配列で合計を！』（タロウＺ）
勉強のため、配列でやっていますが、 A列の検索品番がＤ列になかったら空白にしたいのですが思ったようにできません。 下記のマクロでは、検索品番の一つ前の値と同じになってしまします。 On Error Resume Nextを除けるとマクロが動かないし・・・ どなたか宜しくお願いします。
A列は検索品番、B列は合計数をだしたい。 データーは、D列に品番、E列からJ列は数値
Sub 合計()
On Error Resume Next
lastRow = Range("A" & Rows.Count).End(xlUp).Row
配列 = Range("Ａ２:A" & lastRow)
For i = 1 To lastRow
ANS = WorksheetFunction.Sum(Sheets(1).Range(Range("Ｄ1:Ｄ10000").Find(What:=配列(i, 1)).Address(0, 0)).Resize(1, 7))
配列(i, 1) = ANS
Next
Range("Ｂ2:Ｂ" & lastRow).Value = 配列
End Sub
＜ 使用 Excel：Excel2002、使用 OS：Windows2000 ＞
自分はFindをあまり使用しないのでよくわからないですが、
＞ANS = WorksheetFunction.Sum(Sheets(1).Range(Range("Ｄ1:Ｄ10000").Find(What:=配列(i, 1)).Address(0, 0)).Resize(1, 7))
質問者さんはD1からD10000の範囲で検索品番に引っかかった品番の値をすべて合計したいのだと思うのですが、これだと見つかった行だけしか合計しないような気がします。
もっと簡単なコードがあると思いますが、自分はこんな感じで作ってみました。
Option Explicit
Sub 合計() Dim lastRow As Long Dim lastRowD As Long Dim 配列 As Variant Dim i As Long, j As Long Dim ANS As Long Dim 合計 As Long Dim 集計 As Long Dim cnt As Long
'On Error Resume Next
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRowD = Range("D" & Rows.Count).End(xlUp).Row
配列 = Range("A2:A" & lastRow)
集計 = 0
cnt = 0
For j = 1 To UBound(配列)
For i = 1 To lastRowD
If Cells(i + 1, 4).Value = 配列(j, 1) Then
cnt = cnt + 1
合計 = WorksheetFunction.Sum(Cells(i + 1, 5).Resize(1, 7))
集計 = 集計 + 合計
End If
Next
If cnt = 0 Then
配列(j, 1) = ""
Else
配列(j, 1) = 集計
cnt = 0
End If
集計 = 0
Next j
Range("B2:B" & lastRow).Value = 配列
End Sub
（KUKI） 2015/07/02(木) 14:47
まだ、コードはほとんど読んでいません。 ざっと眺めた感じだけで、コメントします。
１．On Error Resume Nextを除けるとマクロが動かないし・・
そもそも、これが間違っています。エラーになるということは原因があるわけです。 その原因を究明して、ロジックの不備を直すということが、最初の一歩です。
２．Findメソッドでは、見つからなかったときに Nothing がかえります。 その時、Find(What:=配列(i, 1)).Address(0, 0) は Nothing.Address(0,0) になりますのでエラーになります。 Find を単独で実行して、その結果を取得し、Nothing であればスキップ等の措置が必須です。
３．同じく Findメソッドの重要な引数、LookAt (部分一致か完全一致）は、指定がない場合、 直前のエクセル上の置換、検索（手作業、あるいはＶＢＡ処理）の条件を引き継ぎます。 自分がどちらでやりたいのか、それを明記することが必要です。
４．Sheets(1).Range(Range("Ｄ1:Ｄ10000").Find
領域の規定に重大な欠陥があります。（状況によっては結果オーライですが）
Sheets(1).Range ですから、Sheets(1)上の領域ですね。なのに、その中身として、Range("Ｄ1:Ｄ10000")
これは、たままたま、その時にアクティブになっていたシートの D1:D10000 です。
もし、実行時に Sheets(1) がアクティブになっていなければ、1004(かな？）のエラーになります。
なぜ、。ふつうに Sheets(1).Range("Ｄ1:Ｄ10000").Find と記述しないのですか？
ところで、この D10000 ですが、本当に、固定で 10000行までですか？ それとも D列のデータ最終行までという意味ですか？ 後者なら、アップされたコードの別のところで最終行の取得をしていますよね。 ここでも、最終行を取得して領域を指定すべきですね。
★追加です。変数は必ずすべて宣言しましょう。モジュールの先頭に Option Explicit を記述してください。 （ＶＢＥ画面のツール->オプション の編集タブの変数の宣言を強制する にチェックしておくと自動的に記述されます）
（β） 2015/07/02(木) 15:14
とりあえず、アップされたコードの処理方式でコードを整理しますと以下になりますね。 なお、関連データはすべて Sheets(1) にあるという前提です。
Sub 合計2()
Dim 配列 As Variant
Dim i As Long
Dim c As Range
With Sheets(1)
配列 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
For i = 1 To UBound(配列, 1)
配列(i, 2) = Empty
Set c = .Range("D1", .Range("D" & Rows.Count).End(xlUp)).Find(What:=配列(i, 1), LookAt:=xlWhole)
If Not c Is Nothing Then 配列(i, 2) = WorksheetFunction.Sum(c.Offset(, 1).Resize(, 7))
Next
.Range("A2").Resize(UBound(配列, 1), 2).Value = 配列
End With
End Sub
（β） 2015/07/02(木) 15:29
鋭い指摘有難うございます。みなさんの指摘どおりです。 データーは簡単なほうが良いと思いまして・・・
（KUKI）さん とりあえずD列に品番は1つだけです。
（β）さん 最終的に別ブックのシート1を参照する予定でした。
D10000 は、暫定範囲です。最終行を取得して領域を指定します。
無事に目的としたことが出来ました。
みなさん、 いろいろお世話になりました。
追加になるのですが、A列に空白があるのですが、 A列が空白の場合B列も空白にしたいのですがどのように 変更したらいいでしょうか？宜しくお願いします。
（タロウＺ）
Sub 合計3()
Dim 配列 As Variant
Dim i As Long
Dim c As Range
With Sheets(1)
配列 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
For i = 1 To UBound(配列, 1)
配列(i, 2) = Empty
If Not IsEmpty(配列(i, 1)) Then
Set c = .Range("D1", .Range("D" & Rows.Count).End(xlUp)).Find(What:=配列(i, 1), LookAt:=xlWhole)
If Not c Is Nothing Then 配列(i, 2) = WorksheetFunction.Sum(c.Offset(, 1).Resize(, 7))
End If
Next
.Range("A2").Resize(UBound(配列, 1), 2).Value = 配列
End With
End Sub
（β） 2015/07/02(木) 17:13
これでチェック時に大幅に楽になりました。 みなさん有難うございました。
（タロウＺ）
（β）さんの上記の 合計3 のマクロで下記記述がありますが
配列(i, 2) = Empty
理解に苦しんでいます。なぜ必要なのか・・・ 申し訳ありませんが教えてください。
（タロウＺ）
コード処理方法として、B列用の空っぽの配列を別に用意し、マッチした場合に、そこに相当する場所に 値を入れて、最後に、そこからＢ列に落とし込むというやりかたもあります。 アップされたそちらのコードではそれに近いですね。（もっとも ？？ のところもあります。後述）
今回、アップしたコードでは、Resize(,2) で２列の配列（Ａ，Ｂ列）にしています。
配列 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
ということは、２列目は、もともとＢ列に入っていた値ですから、もしかしたら空白かもしれないし もしかしたら何か値が入っているかもしれませんね。
なので、まず、空白にした上でマッチしたら値をセット。こうしておいて最後に
.Range("A2").Resize(UBound(配列, 1), 2).Value = 配列
こうして、２列の領域（Ａ，Ｂ列）に落とし込んでます。
(KUKI)さんも、同じように、以下の部分で、マッチすればそれを、マッチしなければ空白をセットしておられます。
If cnt = 0 Then
配列(j, 1) = ""
Else
配列(j, 1) = 集計
cnt = 0
End If
ところで、そちらのコードですが
配列 = Range("Ａ２:A" & lastRow)
すべての配列の要素としてＡ列の品番が格納されますね。 で、そこに結果をいれていって、Ｂ列に落とし込んでいます。 すべての要素が、集計結果で置き換わればそれでもいいのですが、マッチしなかった場合もありますよね。 (そちらでアップされたコードでは、逆に、その手当てが抜けていましたが） その場合、なにもしなければ、Ｂ列に品番が書きこまれる結果になりますね。
（β） 2015/07/03(金) 16:35
かえって混乱するかもしれませんが、コメントした「B列用の空っぽの配列を別に用意し」の場合のコードです。 (テストしていないので、バグあればご容赦）
Sub 合計4()
Dim 配列 As Variant
Dim 結果 As Variant
Dim i As Long
Dim c As Range
With Sheets(1)
配列 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
ReDim 結果(1 To UBound(配列, 1), 1 To 1)
For i = 1 To UBound(配列, 1)
If Not IsEmpty(配列(i, 1)) Then
Set c = .Range("D1", .Range("D" & Rows.Count).End(xlUp)).Find(What:=配列(i, 1), LookAt:=xlWhole)
If Not c Is Nothing Then 結果(i, 1) = WorksheetFunction.Sum(c.Offset(, 1).Resize(, 7))
End If
Next
.Range("B2").Resize(UBound(結果, 1)).Value = 結果
End With
End Sub
（β） 2015/07/03(金) 17:32
多少の応用はできますが、マクロ自体を最初から書くのはまだまだです。手当てまでは理解できていません。 詳しく解説していただき有難うございます。
なにもしなければ、Ｂ列に品番が書きこまれる結果になりますね。−−−そのとおりです。対処していただき有難うございます。
バグ ありません。完璧です。
（タロウＺ）
追記：私が書いたマクロより （β）さんのマクロは格段に早いです。
有難うございます！
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.