条件4項目 日付&単位&単価&区分(A列、C列、D列、F列)の一致するもののB列及びE列を集計して別シートに書き出したいのです。 

sheet1
A   B   C   D   E   F
日付 数  単位 単価 計  区分
3/12  2    人  10000 20000  通常
3/12  1    人  10000 10000  通常
3/12  1    時間  2000 10000  残業
3/14  4    時間  2000  8000  残業
3/15  4    人  10000 40000  通常

このような表を
sheet2
A   B   C   D   E   F
日付数単位単価計区分
3/12  3    人  10000 30000  通常
3/12  1    時間  2000 10000  残業
3/14  4    時間  2000  8000  残業
3/15  4    人  10000 40000  通常

のようにまとめたいのです。
Dictionaryを用い、A列、C列、D列、F列を一旦結合しkeyとし、同じものが登録されていたら、itemとしてB列及びE列の値を加算させて、登録件数分を書き出しという流れでやりたいのですが、出来ません。
助けて下さい。お願いします。

このQ&Aに関連する最新のQ&A

A 回答 (5件)

/qa4512348.html の続きですか?


その情報をリンク貼っておけば回答側の参考にもなったと思いますよ。

>DictionaryのItemには追加時に連番をふりながら(その連番を)Indexとしてセットし、
>『集計&転記用の配列を別に用意』し、
>Indexでその配列への加算位置を指定してあげるほうが簡単かもしれません。
と書いてたでしょう。

Sub try_3()
  Dim dic As Object 'Dictionary用
  Dim s  As String 'キー文字列結合用
  Dim key As Variant 'key列用
  Dim ary As Variant '集計列用
  Dim c  As Variant '配列Loop用
  Dim v  As Variant '元データ格納用配列
  Dim w  As Variant 'データ集計・書き出し用配列
  Dim n  As Long  '配列の要素index用
  Dim i  As Long
  Dim j  As Long

  key = Array(1, 3, 4, 6) 'key列
  ary = Array(2, 5)    '集計列

  With ThisWorkbook
    v = .Sheets("sheet1").Range("A1").CurrentRegion '.Resize(, 6)
    ReDim w(1 To UBound(v, 1), 1 To UBound(v, 2))

    Set dic = CreateObject("Scripting.Dictionary")
    n = 0
    For i = 1 To UBound(v)
      'キー文字列 s として結合
      s = ""
      For Each c In key
        s = s & v(i, c) & vbTab
      Next
      If dic.Exists(s) Then
        '既登録ならindexを取得
        j = dic(s)
      Else
        '未登録ならindexを追加
        n = n + 1
        dic(s) = n
        j = n
        '未登録なら書き出し用配列 w にkey列をセット
        For Each c In key
          w(j, c) = v(i, c)
        Next
      End If
      '書き出し用配列 w に集計列を加算
      For Each c In ary
        w(j, c) = w(j, c) + v(i, c)
      Next
    Next

    With .Sheets("sheet2")
      .UsedRange.ClearContents
      .Range("A1").Resize(n, UBound(w, 2)).Value = w
    End With
  End With

  Set dic = Nothing
End Sub

前回のコードでも、keyを増やして
key1 key2 key3 key4 集計1 集計2
日付 単位 単価 区分 数   計
の順で書き出した後に、列を入れ替えればよかったんじゃないですか?

#以下、既に実施済みでしたら読み飛ばしてください。
コードを理解するには、ただ眺めるだけじゃなく、VBE[F8]キーで1ステップずつ実行するのが効果的です。
その時[ローカルウィンドウ]を表示させて、変数や配列への格納のされ方も確認してくださいね。

この回答への補足

 end-uさん最近はお世話になりっぱなしです。
全てend-uさんのおっしゃる通りです。じつは前回のコードで、keyを増やして
key1 key2 key3 key4 集計1 集計2
日付 単位 単価 区分 数   計
の順で書き出した後に、列を入れ替えて書き出して動かしてました。(下記のコードで入れ替え。)

 vntData_2 = Columns("B").Value
vntData_3 = Columns("C").Value
vntData_4 = Columns("D").Value
vntData_5 = Columns("E").Value
vntData_6 = Columns("F").Value

Columns("B").Value = vntData_5
Columns("C").Value = vntData_2
Columns("D").Value = vntData_3
Columns("E").Value = vntData_6
Columns("F").Value = vntData_4
しかし、少し時間(列入れ替え時)かかるのと、今回は入れ替えの無いパターンなので、前は作れたのに、時間が経って忘れてしまったのか、今回は単純なパターンなのにつまづいてしまったのは、基礎が、身に付いてなかったせいと思い、そこでまた皆様のお力をお借りしたのでした。本当に忘れないようにします。私は、出張が多いので、本当にお世話になりまくりのend-uさんには、何かお土産でも渡したいと思ってます(心から)なにかよい方法(メールアドレス等)でも教えてもらえれば幸いです。今また出かけなければならないので、ここのお礼は、後ほど必ずいたします。YOKOKAMA46

補足日時:2009/05/13 16:36
    • good
    • 0
この回答へのお礼

end-uさん。今戻りました。バッチリです。
しかしまだまだ
ReDim w(1 To UBound(v, 1), 1 To UBound(v, 2))の部分が私にとって鬼門です。配列の要素数の再定義 この部分をしっかり理解しないと、一気に出来ず、Dictionaryを2回使ったりしなければならなくなりそうです。この部分を勉強させてもらいます。

お礼日時:2009/05/13 22:08

#4補足に対するレスを入れておきます。


(もしかしたら削除対象回答に該当するかもしれませんが、事務局のご判断におまかせします。)

お礼についてはお気持ちだけで充分です。お気になさらず。
回答側の立場で投稿してますが、私も勉強になる事が多いです。
回答者というより利用者という感覚で、Q&Aをケーススタディとして勉強させてもらってます。
それに
http://help.okwave.jp/okwave/beginner/beginner.h …
『OKWaveは利用者の方々からの「質問」と「回答」を通し、世の中のあらゆる問題の解決と、人と人の相互協力のリレーション作りを目指すQ&Aサイトです。』
とあるように、『相互協力』ですから、利用者各個人の得意分野を補完し合っていけば良いのだと思います。
直接私に対してではなくとも、貴方も誰かのお役に立たれているはずです。
そういった連鎖関係の中でお互いが得していると考えておけば良いんじゃないでしょうか。
それはこれから先の事でも構わないし、このコミュニティ内に限った事でもないと思います。


他、今後気をつけたほうがいい事として1点、アドバイスです。
今一度、『■禁止事項ガイドライン』に眼を通されておかれたほうが良いでしょう。
http://help.okwave.jp/okwave/beginner/prohibitio …
会員間の直接のやり取りを促すような記述は削除・編集の対象となっています。
私もメールアドレスなどを公開するつもりはありませんし、前述したように、何か物的なものをお受けするつもりはさらさらありません。
(かといって、補足にお書きになった事で気分を害しているわけでもありません。本当に、お気持ちだけ嬉しくお受け致します^ ^)



本来は、このレスも『指摘回答』だと判断されて削除対象になるかもしれませんが、私からもお礼の気持ちが伝わればと思って書きました。
では、今後ともよろしくお願いします。お互いにこのコミュニティを通して、問題解決やスキルアップができれば良いですネ。
    • good
    • 2
この回答へのお礼

end-uさん。有難うございます。
おっしゃるとおり今まで KenKen-SPさん、n-junさん、onlyromさん、redfox63さん,そしてend-uさん、そのほかの方々 色々な方にお世話になっております。OKWAVEには感謝しております。
end-uさんには特にお世話になっている回数が多いのと私のプロフィールに書いてある通り、以前の私の質問に(締切済み)追加でメール頂いた件は、内容もその後の私の悩みにドンピシャだったので非常に助かった思いがありました。そこで今回のような発言だったのですが、禁止事項ガイドラインにふれるのですね。無念です。それではせめて、end-uさんのご多幸を祈らせて頂くことにとどめます。
またお手数かけることも多いとは思いますが今後もよろしくお願いいたします。yokokama46

お礼日時:2009/05/13 22:29

Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する


http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …
【Dictionaryオブジェクトを作成する】
”・ところが、A列の品名が重複していると、~”
と言う所が参考になるのでは?

この回答への補足

n-junさん 以前も助けて頂きました。今回もまたお手数かけます。
以前もDictionaryを用い似たような集計(条件列と集計列が書き出し時に一部入れ替えがあるので、集計列をaryで示すという方法でした)
今回は書き出し時にレイアウト変更がないのですが、基本を押さえてなかったようで、自分でうまくいきません。
ご提示のページも参考にさせていただきましたが、4条件を結合は下記でよいと思いますが、その先の2つのアイテム追加のしかたと、出来たとしても書き出し時がいまいち解りません。これを機に今一度Dictionaryの勉強をしますので、なにとぞご教示のほどよろしくお願いします。

myVal = sh1.Range("F1", sh1.Range("A" & sh1.Rows.Count).End(xlUp)).Value

Set myDic = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(myVal, 1)

End If
myVal2 = myVal(i, 1) & "_" & myVal(i, 3) & "_" & myVal(i, 4) & "_" & myVal(i, 6)
If Not myVal2 = "_" & "_" & "_" Then
If myDic.exists(myVal2) Then

補足日時:2009/05/13 15:31
    • good
    • 0
この回答へのお礼

n-junさん返事遅れてすみません。以前n-junさんから頂いたコードのシンプル版なので、end-uさんへの補足に述べさせて頂いたとおり、n-junさんから頂いたコードを最後に列の入れ替えをして、対応は出来たのですが、入れ替え無いパターンは(ただし集計列1列)自分でも出来ていたので、集計列2列にも挑戦したのですが、撃沈でした。そこでn-junさんから頂いたコードを最後に列の入れ替えをする対応で済ます予定でしたが、せっかくだから基本を覚えようと思ったしだいです。n-junさんは色々なかたに幅広く答えていらっしゃいますし私も何度かお世話になっております。重ねてお礼申し上げます。
またよろしくお願いします。yokokama46

お礼日時:2009/05/13 22:02

エクセルVBAを、どれほどこなせるレベルか知ら無いが、Dictionaryなどの凝った仕組みを使わずとも、普通のVBA(ソート法などで)簡単に出来るよ。

Dictionaryの練習問題ならいざ知らず、ベテランはなるべく単純な使い慣れた仕組みを使うと思う。
Dictionaryを使いこなせるレベルなら、デバッグなど自力で出来る力が有るはずだ。
Googleででも「VBScript dictionary」で照会でもして、たくさん出る記事の適当なものを読みましたか。
ーーー
文字列を結合したKeyを作るとき、定桁結合式にしないと、おかしくなることが有ることを注意してますか。
ーーー
私の言うやり方でやってみる。
IFと代入しか使ってない。質問者は、他シート参照がなれているかな。
ただしロジックは易しいと思うが、先人のロジックで、長く使い続けて慣れた面はある。
例データ ソート後
日付数単位単価計区分
3月12日1時間200010000残業
3月12日2人1000020000通常
3月12日1人1000010000通常
3月12日4人1000010000通常
3月12日2人1000020000通常
3月14日4時間20008000残業
3月14日2人1000020000通常
3月15日4人1000040000通常
3月15日1人2000020000通常
3月15日2人2000020000通常
ーー
コード
Sub test01()
Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("Sheet2")
Set sh2 = Worksheets("Sheet3")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
k = 2: t1 = 0: t2 = 0
m1 = sh1.Cells(2, "A"): m2 = sh1.Cells(2, "C"): m3 = sh1.Cells(2, "D"): m4 = sh1.Cells(2, "F")
'---
For i = 2 To d
If sh1.Cells(i, "A") = m1 And sh1.Cells(i, "C") = m2 And sh1.Cells(i, "D") = m3 And sh1.Cells(i, "F") = m4 Then
t1 = t1 + sh1.Cells(i, "B")
t2 = t2 + sh1.Cells(i, "E")
Else
sh2.Cells(k, "A") = m1
sh2.Cells(k, "B") = t1
sh2.Cells(k, "C") = m2
sh2.Cells(k, "D") = m3
sh2.Cells(k, "E") = t2
sh2.Cells(k, "F") = m4
k = k + 1
m1 = sh1.Cells(i, "A"): m2 = sh1.Cells(i, "C"): m3 = sh1.Cells(i, "D"): m4 = sh1.Cells(i, "F")
t1 = sh1.Cells(i, "B")
t2 = sh1.Cells(i, "E")
End If
Next i
sh2.Cells(k, "A") = m1
sh2.Cells(k, "B") = t1
sh2.Cells(k, "C") = m2
sh2.Cells(k, "D") = m3
sh2.Cells(k, "E") = t2
sh2.Cells(k, "F") = m4
End Sub
ーーー
結果
日付数単位単価計区分
2009/3/121時間200010000残業
2009/3/129人1000060000通常
2009/3/144時間20008000残業
2009/3/142人1000020000通常
2009/3/154人1000040000通常
2009/3/153人2000040000通常
第1行見出しは、元のシートの見出し行をコピー貼り付けする。

この回答への補足

imogasiさん。急用で出かけてまして今戻りました。返事遅れてすいません。出かける直前に、最後のend-uさんのコードを試させて頂き動きました。imogasiさんのは今試させていただいたのですが、imogasiさんの例示とその結果のようになればよいのですが、なぜか、同項目同士の累計がなされませんでした。(累計なくまったく同じものが転記される)。もしかしたら私のミスかもしれませんのでお気を悪くせずに今後もよろしくお願いします。

補足日時:2009/05/13 21:37
    • good
    • 0

まずはできているものを提示なさっては?


また、どのようにうまくいかないのでしょうか?

この回答への補足

fujillinさん初めまして。最初に返事頂いたのに諸事情により、返事遅れてすみませんでした。やりたかったことと途中までのコードは、n-junさんへの解答のとうりでした。色んな方のお力をお借りしてばかりの私なので今後ともよろしくお願いします。

補足日時:2009/05/13 21:45
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qexcel vba 複数項目の集計

EXCEL2003 VBAにてマクロを作成しているのですが、作成日程が迫っているにも関わらず、
すぐ行き詰ってしまいます。どうかご指導お願い致します。

以下のような事をしたいのですが、できる限り高速で最も効率の良い方法を教えていただきたいと
思っております。よろしくお願い致します。

あるSheetに以下のようにデータが登録されていて、
A       B        C
りんご    赤       200
なし     黄色      100
りんご    緑       100
メロン    緑       10
なし     黄色      200
りんご    緑       500

これを集計すると、
りんご  赤  200
りんご  緑  600
なし   黄色 300
メロン  緑  10
と、結果を返したいと考えています。

数字を合計するのはA列とB列がともに一致した時のみです。

最初は単純に何回もForNextで処理しようと思ったのですが、行数が
多くなると繰り返し回数も多くなり、時間もかかってしまうので、
別の方法でもっといい方法があればと思い、質問させていただきました。
宜しくお願いします。

EXCEL2003 VBAにてマクロを作成しているのですが、作成日程が迫っているにも関わらず、
すぐ行き詰ってしまいます。どうかご指導お願い致します。

以下のような事をしたいのですが、できる限り高速で最も効率の良い方法を教えていただきたいと
思っております。よろしくお願い致します。

あるSheetに以下のようにデータが登録されていて、
A       B        C
りんご    赤       200
なし     黄色      100
りんご    緑       100
メロン    緑   ...続きを読む

Aベストアンサー

自前で検索するのをやめて Scripting.Dictionaryオブジェクトに任せるなら

Sub Test()
  Dim dicName As New Dictionary
  Dim r As Range
  Dim dicCor As Dictionary
  Dim sName, sColor, obj
  Dim nn As Integer

  ' データの集計
  For Each r In Range("A2", Range("A65536").End(xlUp))
    ' りんご、なし、メロンなどを取得
    sName = r.Value
    ' 色を取得
    sColor = r.Offset(, 1).Value
    ' 値段を取得
    nn = r.Offset(, 2).Value
    ' dicNameに登録済みか検査
    If dicName.Exists(sName) = False Then
      ' 未登録なら 色、値段を登録
      Set dicCor = New Dictionary
      dicCor.Add sColor, nn
      dicName.Add sName, dicCor
    Else
      ' 登録済みの場合 色情報を検査
      Set dicCor = dicName(sName)
      If dicCor.Exists(sColor) = False Then
        ' 色情報が未登録なら 新規登録
        dicCor.Add sColor, nn
      Else
        ' 色情報があるなら 値段を更新
        nn = dicCor(sColor) + nn
        dicCor(sColor) = nn
      End If
      ' 色情報を更新
      Set dicName(sName) = dicCor
    End If
  Next

  ' 出来上がったデータを表示
  For Each sName In dicName
    Set dicCor = dicName(sName)
    For Each sColor In dicCor
      n = dicCor(sColor)
      ' セルに転記するなら Rangeなどに置き換えましょう
      Debug.Print sName, sColor, nn
    Next
  Next
End Sub
といった具合で ・・・

自前で検索するのをやめて Scripting.Dictionaryオブジェクトに任せるなら

Sub Test()
  Dim dicName As New Dictionary
  Dim r As Range
  Dim dicCor As Dictionary
  Dim sName, sColor, obj
  Dim nn As Integer

  ' データの集計
  For Each r In Range("A2", Range("A65536").End(xlUp))
    ' りんご、なし、メロンなどを取得
    sName = r.Value
    ' 色を取得
    sColor = r.Offset(, 1).Value
    ' 値段を取得
    nn = r.Offset(, 2).Value
    ...続きを読む

QVBA DictionaryオブジェクトのItemについての質問です。

エクセル2000です。
A列からE列までの1行から最終行不特定の表があります。
A列はすべて文字列で、B~Gは数値、E列は文字列です。
A列の文字列には重複があります。

この表を別シートにA列の重複がない表として作成したいと思います。
その際、列が重複する場合にはB~G列は合計数値、E列は文字列を結合させます。

Dictionaryオブジェクトを用い、A列データをKey、B~E列データを配列でItemとして下記のコードを書きました。
このコードで目的は達成しました。
質問はKeyが重複する場合、B~E列のデータを配列として取り込んだItemに次のB~E列のデータを加算あるいは結合する方法の簡略化です。
このコードではItem内の配列データを、さらに配列変数のmyArに代入して、要素ごとにForNextで回しましたが、配列変数にわざわざ代入しなくとも出来る方法があるかどうかが知りたいのです。
あるいはまったく別な方法でもかまいません。
ご教示いただければ幸いです。

Sub ItemsTest()
Dim myDic As Object, ns As Worksheet '変数宣言
Dim c As Range, cc As Range, i As Integer
Dim myAr
Set myDic = CreateObject("Scripting.Dictionary") 'myDicを用意
For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) 'A列の各データについて
If Not myDic.exists(c.Value) Then 'myDicになければ
myDic.Add c.Value, Array(c.Offset(0, 1).Value, c.Offset(0, 2).Value, c.Offset(0, 3).Value, c.Offset(0, 4).Value) '追加しB~E列データを配列でItemに
Else 'myDicにあれば
myAr = myDic(c.Value) 'Itemを配列myArに
For i = LBound(myAr) To UBound(myAr)
myAr(i) = myAr(i) + c.Offset(0, i + 1).Value '配列の要素ごとに加算
Next i
myDic(c.Value) = myAr '配列myArをItemにもどす
End If
Next c '繰り返し
Set ns = Worksheets.Add(After:=ActiveSheet) 'シートを追加
ns.Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) 'A列にKeyデータ転記
For Each cc In ns.Range("A1:A" & myDic.Count)
cc.Offset(0, 1).Resize(, UBound(myAr) + 1).Value = myDic.Item(cc.Value) 'B~E列にItemデータ転記
Next
End Sub

 (o。_。)oペコッ

エクセル2000です。
A列からE列までの1行から最終行不特定の表があります。
A列はすべて文字列で、B~Gは数値、E列は文字列です。
A列の文字列には重複があります。

この表を別シートにA列の重複がない表として作成したいと思います。
その際、列が重複する場合にはB~G列は合計数値、E列は文字列を結合させます。

Dictionaryオブジェクトを用い、A列データをKey、B~E列データを配列でItemとして下記のコードを書きました。
このコードで目的は達成しました。
質問はKeyが重複する場合、B~E列のデー...続きを読む

Aベストアンサー

こんにち わ
遅くなってすみません。さっそくですが
まずは説明の為の実験から話をすすめさせて下さい。

ご提示のソースコードで、
myDic の設定が終わった後の行、Set ns =~の行の直前に、
以下、4行を挿入して、
 Dim Arr(1) As Variant
 Arr(0) = myDic.Keys
 Arr(1) = myDic.Items
 Stop
実行後、Stop状態でローカルウィンドウを眺めて見ると、

[-] Arr ◇ myDic
├[-] Arr(0) ◇ myDic.Keys
│├[-] Arr(0)(0) ◇ myDic.Keys(0)
│├[-] Arr(0)(1) ◇ myDic.Keys(1)
│├[-] Arr(0)(2) ◇ myDic.Keys(2)
│├ ・
│└ ・
└[-] Arr(1) ◇ myDic.Items
 ├[-] Arr(1)(0) ◇ myDic.Items(0)
 │├[-] Arr(1)(0)(0) ◇ myDic.Items(0)(0)
 │├[-] Arr(1)(0)(1) ◇ myDic.Items(0)(1)
 │├[-] Arr(1)(0)(2) ◇ myDic.Items(0)(2)
 │├ ・
 │└ ・
 ├[+] Arr(1)(1) ◇ myDic.Items(1)
 ├[+] Arr(1)(2) ◇ myDic.Items(2)
 ├ ・
 └ ・

こんな樹形図が現れます。
myDicの中身を、ひとつのVariant変数Arrに喩えたら。という話ですが、
 Arrは一次元配列で、
 Arrの要素Arr(0)、Arr(1)は、それぞれ一次元配列、
 Arr(1)の要素Arr(1)(0 To X)は、それぞれ一次元配列、
 Arr(1)(0 To X)の要素はArr(1)(0 To X)(0 To Y)、
一次元多段階配列で階層構造がみえてきます。
ご提示のソースコードをみて、頭の中のイメージで
上のような樹形図が浮かび、窮屈な(かなり難しそうな)印象を受けました。
(In/Outどちらかが、樹形図様なら、自然なんでしょうけれど。)
Dictionaryで扱っているとそうは感じないのですが実際は結構複雑です。
配列の中身が配列っていうのを、二段階配列なんて呼びますけれど、
二次元配列より、難易度(扱い難さ)は上。という認識でいます。
『セル範囲→二次元配列→セル範囲』二次元で統一したら、
楽なんじゃないかな?と思って前稿を書いてみたのですが、
反ってわかり難い、ということのようですね。
それはそれで、とても感覚的なことだと思うので、
重ねて意見をおすつもりはありません。
ややっこしく感じない方法を選べばよいのです。
でもまぁ無駄になる話でもないつもりなので、時間のある時にでも、
考えて頂ければ、幸いです。

>ただ、1次元配列では配列インデックスは0から、
>二次元配列は1からだと思っていたところ、
>二次元でも0からに出来るんですね、
>しかも次元ごとに0と1を組み合わせるなんてことも!

0でも1でも、それ以上でも、自分で定義すればいいです。

 Option Base 1
とモジュールの宣言部に書いておけば(機会は少ないですが)、
 Dim A(5, 4)
は、A(1 To 5, 1 To 4)

 Option Base 0
(デフォルトでBase 0なので通常は省略しますが)ならば、
 Dim A(5, 4)
は、A(0 To 5, 0 To 4)

 どちらの場合でも
 Dim A(2 To 5, 3 To 4)
は、A(2 To 5, 3 To 4)

(以上は自分で定義した場合、以下はそれ以外)

 Option Base によらず、どちらの場合でも
 vA = Range("any").Value
は、1ベース

 v = Split("A B")
や、
 Lbound(myDic.keys)
は、0ベース、

ちょっとややこしいけど、とりあえず(myDic.keysは別としても)
これ位の場合分けを覚えておけば、困ることは少ないと思います。
使い慣れない関数、メソッドやプロパティから配列を変数に受ける時は、
ローカルウィンドウなど(できればヘルプ)で、確認すればよいです。

 vA = Range("any").Value、セル範囲の値(配列)の場合、
(行数や列数がひとつでも)必ず1ベースの二次元配列を返す。このことを、
少し混乱して覚えていたのではないでしょうか。
次元数でBaseが決まるのではなく、関数、メソッドやプロパティなど、
で決まります。

>また、ReDim Preserve vAP~で出力用配列を再定義したのは、
>当初の vAPが、Keyを取り込んだ1次元配列を、
>出力用に2次元に変換するためですね?
(後の補足欄のコメント)
>でもDictionaryって一次元配列ですよね?どうしてなんでしょう?

>>vAP = Application.Transpose(myDic.Keys) ' 出力用配列にKeysを渡す
結果は、vAP(1 To c, 1 To 1) で、この時点で、二次元になってます。
Application.Transpose()の機能によって二次元配列に変換されます。
(cはmyDic.Keys.Countと同値)
>>ReDim Preserve vAP(1 To c, 0 To lC) ' 出力用配列を再定義
1)vAP(every, 1)にあった値は、vAP(every, 0)に移ります。
LBound(,2)がLBound(,2)に移るって考えればいいと思います。
2)vAP(1 To c, 0 To lC)で、
出力側のセル範囲にサイズを合わせています
(0ベースですから、実際の列番号とは相対です)。
vAP(every, 0)は、Keys相当。
vAP(every, 1 To lC)は、計算の為の作業スペースであり、
最終的には求める値(出力する配列)にもなる、ということです。


>...書き換えてみましたが、同じでことすね?

結果は、全く同じです。
その場合は最初にlCを設定する時の-1を消して、全体を合わせて書けば、
文字数(演算回数)もほぼ(j - 1の部分以外)同じになります。
取得した配列vAVのインデックスを基準にするか、
シート上の列番号を基準にするか、の違いだけです。
工夫の余地はあると思います。

>縦ヨコでインデックスが異なる

>> vAP(lB, j) = vAP(lB, j) + vAV(i, j)
iは、元の(重複を含む)表の行を上から下に走る。
元の表のi行めにあるキーとなる(1列めの)文字列は
myDic.KeysのlB番め(1から数えて)にあるから、
■出力側のlB行め(キーに対応したユニークな位置)の、
■j列(元の表、出力側の表、ともに2列めが1となる相対位置)の
■【vAP(lB, j)】
 に、
◆元の(重複を含む)表のi行めの、
◆j列(元の表、出力側の表、ともに2列めが1となる相対位置)の
◆【vAV(i, j)】
 を
 加算(連結)する
うーん、、、うまく伝わるかなぁ。

前後しましたが、
>> つまりテーブル操作をDictでやるという趣旨でしょうか?
>「テーブル操作」って何でしょう?のレベルなものですから・・・。
これは答えるの難しいですね。
私自身が用語を未整理なまま使ってしまいました。すみません。
そうでなくても難しいのですけれど。
「テーブル」という表現をやめて「表」でいうと、
「ある表から、もうひとつの表を参照して、新たな表を作る。」
私が書いたものでは、
myDicは、Key文字列と対応するID(インデックス)とでひとつの「表」
(よくLOOKUP等の関数で参照先セル範囲にあるリストのよう)になっていて、
元のシートにある「表」とをすり合わせて、
新しいシートに新しい「表」を作っています。
(ここからはまた、感覚的なのですが、)私にはご提示のソースコードが、
上に書いたような意味で同じように"見える"ということです。
拡大解釈をすれば、データベースにとってのクエリに似たような処理、
ですよね。それをDictを使って処理するのは目から鱗ですね。
ってな感じのことを言わんとしたのですが、あまり深く考えないでおいて
貰えると、私も幸せになれるのですが(^^;)。

自己レス
>>文字列の連結に+演算子を使うことについては、
>>Variant変数同士ですから、ま、いいかな、と。
ダメじゃん。せいぜい、
 Variant変数同士ですし、条件が合うなら、ま、いいかな、とも思います。
あと、
>>勝手に.CurrentRegionにしてますが、
 元のセル範囲の行数を取得することなく実現することで、
 For Each で回すメリットを強調したかったもので、、、。

全体に書き足りないこと書きすぎていることが目立ってわかり難くなって
ました(反省)。いつも、すみません。

こんにち わ
遅くなってすみません。さっそくですが
まずは説明の為の実験から話をすすめさせて下さい。

ご提示のソースコードで、
myDic の設定が終わった後の行、Set ns =~の行の直前に、
以下、4行を挿入して、
 Dim Arr(1) As Variant
 Arr(0) = myDic.Keys
 Arr(1) = myDic.Items
 Stop
実行後、Stop状態でローカルウィンドウを眺めて見ると、

[-] Arr ◇ myDic
├[-] Arr(0) ◇ myDic.Keys
│├[-] Arr(0)(0) ◇ myDic.Keys(0)
│├[-] Arr(0)(1) ◇ myDic.Keys(1)
│├[-] Arr(0)(2) ◇...続きを読む

Q途中まで出来ているのですが‥(Dicへの複数item追加?)

   A   B   C   D   E    ←シート元
1 大区分 中区分 金額1 金額2 小区分  ←見出し行です。
2  A社 管理課 12000  3000  1
3  B社 総務課 10000  2000  1
4  C社 業務課  800 1000    3
5  A社 総務課           5
6  C社 製造課  600 5000    2
7  A社 製造課 15000        1
8  A社 管理課  300       1
9  B社 管理課  800 2000     4
10  D社 総務課 90000 9000     1
を大区分 中区分 小区分をKeyにして3要素が同じものをまとめて並び替えて集計するのですが(下記のように 金額1 金額2ごとに足し算)
   A   B   C   D   E    ←シート集計
1 大区分 中区分 小区分金額1 金額2   ←見出し位置変更
2  A社 管理課  1 12000 3300
3  A社 総務課  5  
4  A社 製造課  1 15000  
5  B社 総務課  1 10000 2000
6  B社 管理課  4 8000 2000
以下省略
実際に作りたいものは、元シートの金額の項目が多いのです(列が飛び飛びに40位あります)今回の例でいえばCとDが CからF HからV ABからCHとなりそれぞれ金額3,4,5~50みたいになってます。私なりに下記のコードのように進めてますが、表題のようにDictionaryに複数のitemを追加する方法が解らないため、金額の項目ごとに算出を繰り返すという効率が悪い方法をとってます。どなたかご教示頂けると幸いです。

Sub 3keyと2要素()
’実際は40要素くらいある
Dim OLDBOOK As Workbook
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim myDic As Object, myKey, myItem
Dim myVal, myVal2, myVal3, myVal4, myVal5
Dim i As Long
Set OLDBOOK = ThisWorkbook
Set SH1 = OLDBOOK.Worksheets("元")
Set SH2 = OLDBOOK.Worksheets("集計")
SH2.Cells.ClearContents
SH2.Range("A1:B1").Value = SH1.Range("A1:B1").Value
SH2.Range("C1").Value = SH1.Range("E1").Value
SH2.Range("D1:E1").Value = SH1.Range("C1:D1").Value
Set myDic = CreateObject("Scripting.Dictionary")
SH1.Select
myVal = SH1.Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 5).Value
For i = 1 To UBound(myVal, 1)
myVal2 = myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 5)
If Not myVal2 = "_" & "_" Then
If Not myDic.exists(myVal2) Then
myDic.Add myVal2, myVal(i, 3)
Else
myDic(myVal2) = myDic(myVal2) + myVal(i, 3)
End If
End If
Next
myKey = myDic.keys ' 書き出し とりあえず2要素
  myItem = myDic.items
For i = 0 To UBound(myKey)
myVal3 = Split(myKey(i), "_")
SH2.Cells(i + 2, 1).Value = myVal3(0)
SH2.Cells(i + 2, 2).Value = myVal3(1)
SH2.Cells(i + 2, 3).Value = myVal3(2)
SH2.Cells(i + 2, 4).Value = myItem(i)
Next
Set myDic = Nothing
'********
Set myDic = CreateObject("Scripting.Dictionary")
myVal = SH1.Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 5).Value
For i = 1 To UBound(myVal, 1)
myVal2 = myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 5)
If Not myVal2 = "_" & "_" Then
If Not myDic.exists(myVal2) Then
myDic.Add myVal2, myVal(i, 4)
Else
myDic(myVal2) = myDic(myVal2) + myVal(i, 4)
End If
End If
Next
myKey = myDic.keys
myItem = myDic.items
For i = 0 To UBound(myKey)
myVal3 = Split(myKey(i), "_")
SH2.Cells(i + 2, 5).Value = myItem(i)
Next
Set myDic = Nothing
' 以下繰り返しするしかなく困ってます
SH2.Select
SH2.Range("A2", Range("E" & Rows.Count).End(xlUp)).Sort _
Key1:=Range("AF2"), Order1:=xlAscending, _
Key2:=Range("B"), Order2:=xlAscending, _
Key3:=Range("C2"), Order3:=xlAscending, _
Header:=xlGuess
Set OLDBOOK = Nothing
Set SH1 = Nothing
Set SH2 = Nothing
End Sub

   A   B   C   D   E    ←シート元
1 大区分 中区分 金額1 金額2 小区分  ←見出し行です。
2  A社 管理課 12000  3000  1
3  B社 総務課 10000  2000  1
4  C社 業務課  800 1000    3
5  A社 総務課           5
6  C社 製造課  600 5000    2
7  A社 製造課 15000        1
8  A社 管理課  300       1
9  B社 管理課  800 2000     4
10  D社 総務課 90000 9...続きを読む

Aベストアンサー

>これを元に範囲指定をCurrentRegionではなく飛び飛びの列対応に広げれば、対応できると思います。
念のため。
Pivotの範囲指定は飛び飛びではできませんから、
全体を範囲指定して、集計したい項目をデータフィールドに追加するような対応になります。



>(飛び飛びの複数列といいましても列は固定です。)Keyにitemとして
>Cells(,)と Cells(,)とCells(,)と沢山付ける記述のしかた、
>そして加算してゆく方法、
>そして切り離し転記する方法を覚えたいのです。
飛び飛びの複数列対応は
ary = VBA.Array(3, 4) '集計列
などとして集計列を指定した ary をLoopさせれば良いです。
一応、転記をまとめて行う例も含め、サンプルとして提示しておきます。

Option Explicit

Sub try2()
  Dim OLDBOOK As Workbook
  Dim SH1   As Worksheet
  Dim SH2   As Worksheet
  Dim myDic  As Object
  Dim i    As Long
  Dim j    As Long
  Dim n    As Long
  Dim myVal, myVal2, ary, tmp, v, w, x, key

  ary = VBA.Array(3, 4)  '集計列

  Set OLDBOOK = ThisWorkbook
  Set SH1 = OLDBOOK.Worksheets("元")
  Set SH2 = OLDBOOK.Worksheets("集計")
  SH2.Cells.ClearContents
  SH2.Range("A1:B1").Value = SH1.Range("A1:B1").Value
  SH2.Range("C1").Value = SH1.Range("E1").Value
  SH2.Range("D1:E1").Value = SH1.Range("C1:D1").Value
  myVal = SH1.Range("E2", SH1.Range("A" & SH1.Rows.Count).End(xlUp)).Value

  Set myDic = CreateObject("Scripting.Dictionary")

  For i = 1 To UBound(myVal, 1)
    myVal2 = myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 5)
    If Not myVal2 = "_" & "_" Then
      If myDic.exists(myVal2) Then
        tmp = myDic(myVal2)
      Else
        ReDim tmp(0 To UBound(ary))
      End If
      j = 0
      For Each v In ary
        tmp(j) = tmp(j) + myVal(i, v)
        j = j + 1
      Next
      myDic(myVal2) = tmp
    End If
  Next

  n = myDic.Count
  ReDim w(0 To n - 1)
  i = 0
  For Each key In myDic.keys
    w(i) = Split(key, "_")
    i = i + 1
  Next
  With Application
    w = .Transpose(.Transpose(w))
    x = .Transpose(.Transpose(myDic.items))
  End With
  SH2.Cells(2, 1).Resize(n, UBound(w, 2)).Value = w
  SH2.Cells(2, 4).Resize(n, UBound(x, 2)).Value = x
  Set myDic = Nothing

  SH2.Range("E2", SH2.Range("A" & SH2.Rows.Count).End(xlUp)).Sort _
    Key1:=SH2.Range("A2"), Order1:=xlAscending, _
    Key2:=SH2.Range("B2"), Order2:=xlAscending, _
    Key3:=SH2.Range("C2"), Order3:=xlAscending, _
    Header:=xlNo

  Set OLDBOOK = Nothing
  Set SH1 = Nothing
  Set SH2 = Nothing
End Sub

>これを元に範囲指定をCurrentRegionではなく飛び飛びの列対応に広げれば、対応できると思います。
念のため。
Pivotの範囲指定は飛び飛びではできませんから、
全体を範囲指定して、集計したい項目をデータフィールドに追加するような対応になります。



>(飛び飛びの複数列といいましても列は固定です。)Keyにitemとして
>Cells(,)と Cells(,)とCells(,)と沢山付ける記述のしかた、
>そして加算してゆく方法、
>そして切り離し転記する方法を覚えたいのです。
飛び飛びの複数列対応は
ary ...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Qエクセルの表の集計をVBAでやりたいのです。

エクセルのsheet1にこのような表があります。
A B C D E
1 名称 金額
2 あああああ 10000
3 あああああ 12000
4 あああああ 9000
5 いいいいい 9500
6 いいいいい 11000
7 ううううう 15000
8 えええええ 12000
9 おおおおお 10000
10 おおおおお 14000
11 かかかかか 13000
12 ききききき 800

以下多数

この表で、それぞれ同じ名称の個数と合計金額を求めたいのです。
たとえば「ああああ」なら個数 3、合計 31000 と、D4とE4に、
「いいいい」なら個数 2、合計 25000 と、D6とE6に入れたいのです。
実際の表はデータ件数が1万件を越えますのでいちいち手で入れるわけにはいきません。
VBAでやるにはどう記述したらいいでしょうか?
どうかお助けください。よろしくお願いします。

エクセルのsheet1にこのような表があります。
A B C D E
1 名称 金額
2 あああああ 10000
3 あああああ 12000
4 あああああ 9000
5 いいいいい 9500
6 いいいいい 11000
7 ううううう 15000
8 えええええ 12000
9 おおおおお 10000
10 おおおおお 14000
11 かかかかか 13000
12 ききききき 800

以下多数

この表で、それぞれ同じ名称の個数と合計金額を求めたいのです。
たとえば「ああ...続きを読む

Aベストアンサー

A列は名称でB列は金額でよろしいんですよねというか
その前提で書きましたが。
デバッグはしてません。またオーバーフロー等あると思うのでそのあたりはご自分で。

Sub 集計()
Dim i, MyTotal As Double, MyCount As Double
MyTotal = Sheets(1).Range("A2")(1, 2)
MyCount = 1
For i = 2 To 65535
If Sheets(1).Range("A2")(i) = "" Then Exit For
If Sheets(1).Range("A2")(i) = Sheets(1).Range("A2")(i - 1) Then
MyTotal = MyTotal + Sheets(1).Range("A2")(i, 2)
MyCount = MyCount + 1
Else
Sheets(1).Range("A2")(i - 1, 4).Formula = MyCount
Sheets(1).Range("A2")(i - 1, 5).Formula = MyTotal
MyTotal = Sheets(1).Range("A2")(i, 2)
MyCount = 1
End If
Next i
Sheets(1).Range("A2")(i - 1, 4).Formula = MyCount
Sheets(1).Range("A2")(i - 1, 5).Formula = MyTotal
End Sub

A列は名称でB列は金額でよろしいんですよねというか
その前提で書きましたが。
デバッグはしてません。またオーバーフロー等あると思うのでそのあたりはご自分で。

Sub 集計()
Dim i, MyTotal As Double, MyCount As Double
MyTotal = Sheets(1).Range("A2")(1, 2)
MyCount = 1
For i = 2 To 65535
If Sheets(1).Range("A2")(i) = "" Then Exit For
If Sheets(1).Range("A2")(i) = Sheets(1).Range("A2")(i - 1) Then
MyTotal = MyTotal + Sheets(1).Ran...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

Q複数条件が一致で別シートに転記【エクセルVBA】

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
------------------------------------------------
2 たけだ  配達  6/20(月) 13:00  2個
3 みうら  配達  6/18(土) 14:00  4個
4 らもす  郵送  6/20(月)  ―   5個
5 いはら  配達  6/20(月) 14:30  8個
6 かつや  配達  6/20(月) 15:00  6個
7 みうら  郵送  6/20(月)  ―   4個

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00
3  12:30
4  13:00
5  13:30
6  14:30
7  15:00
8  15:30
9  16:00

マクロを実行すると・・・
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00 
3  12:30
4  13:00    たけだ   2個
5  13:30
6  14:00    みうら   4個
6  14:30   いはら   8個
7  15:00   かつや   6個
8  15:30
9  16:00

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
-...続きを読む

Aベストアンサー

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表は、VBAを勉強してそれを使うべきと思う(既に回答も出ているようだ)
関数で抜き出し問題や表の組み換えは、VBAで無いと、天下りの長い式をコピペで使うだけになる。
ーー
私が紹介している「imogasi方式」では、Sheet2に時刻の所定の行に出す問題なので複雑になりすぎる。
ーー
VBAでやってみる。
例データ
しめい対応配達日時間個数
たけだ配達6月20日13:002個
みうら配達6月18日14:004個
らもす郵送6月20日ーー5個
いはら配達6月20日14:308個
かつや配達6月20日15:006個
みうら郵送6月20日ーー4個
(注意)
「ーー」セルは空白とする
「月日」列は、エクセルの年月日を入れておくこと(日付シリアル値(わかりますか)) 文字列では不可
6/20(月) の様な表示は、表示形式の設定でやること(エクセルの常識)  m/d(aaa)
時間の列も時刻シリアル値で入れてあるとする。文字列では不可
ーー
コード
標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "B") = "配達" And sh1.Cells(i, "C") = sh2.Range("B1") And _
sh1.Cells(i, "D") <> "" Then
t = sh1.Cells(i, "D")
'---Sheet2で時刻行を探す
For r = 2 To 30
If sh1.Cells(i, "D") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "A")
Sheet2.Cells(r, "C") = sh1.Cells(i, "E")
End If
Next i
End Sub
ーー
実行結果
Sheet2
配達6月20日
12:00
12:30
13:00たけだ2個
13:30
14:00
14:30いはら8個
15:00かつや6個
15:30
16:00
・・・・・・

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表...続きを読む

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報