Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1489 / 13644 ツリー ←次へ | 前へ→

【74041】4列一致したものを集めて集計 nonoka 13/4/9(火) 16:53 質問[未読]
【74042】Re:4列一致したものを集めて集計 UO3 13/4/9(火) 17:37 発言[未読]
【74043】Re:4列一致したものを集めて集計 UO3 13/4/9(火) 17:40 発言[未読]
【74045】Re:4列一致したものを集めて集計 nonoka 13/4/9(火) 18:11 質問[未読]
【74046】Re:4列一致したものを集めて集計 nonoka 13/4/9(火) 18:30 質問[未読]
【74047】Re:4列一致したものを集めて集計 UO3 13/4/9(火) 19:54 発言[未読]
【74048】Re:4列一致したものを集めて集計 nonoka 13/4/9(火) 20:30 回答[未読]
【74049】Re:4列一致したものを集めて集計 UO3 13/4/9(火) 21:16 発言[未読]
【74056】Re:4列一致したものを集めて集計 nonoka 13/4/11(木) 8:14 回答[未読]
【74057】Re:4列一致したものを集めて集計 UO3 13/4/11(木) 10:32 発言[未読]
【74062】Re:4列一致したものを集めて集計 nonoka 13/4/12(金) 8:52 回答[未読]
【74063】Re:4列一致したものを集めて集計 UO3 13/4/12(金) 9:53 発言[未読]
【74084】Re:4列一致したものを集めて集計 nonoka 13/4/17(水) 18:23 お礼[未読]
【74050】Re:4列一致したものを集めて集計 UO3 13/4/10(水) 11:16 発言[未読]
【74058】Re:4列一致したものを集めて集計 nonoka 13/4/11(木) 14:41 回答[未読]
【74061】Re:4列一致したものを集めて集計 UO3 13/4/12(金) 0:03 発言[未読]

【74041】4列一致したものを集めて集計
質問  nonoka  - 13/4/9(火) 16:53 -

引用なし
パスワード
   いつもお世話になりありがとうございます。
お助けください。

シート名"Shipped"
表D9;J9(見出し)10行目から下にデータがあります。
D、E、F、Gに品番、注番、カラー、必要数が入ってます。
Jにはオーダー個数があります。

D、E、F、Gが一致しているものを
シート名"send list"の5行目から下にB、C、D、Eに一行にまとめて転記。
シート名"Shipped"J列の合計をF列に入力。

シート名"send list"G列は上の処理でJ列に数字が入ればE列−F列の計算結果をG列に記入したいです。


(例)
シート名"Shipped"
DDD EEE FFF 450   200
DDD EEE FFF 450   150
DDD EEE GGG 100   100
これを

シート名"send list"
DDD EEE FFF 450   350
DDD EEE GGG 100   100
というふうにまとめたいです。


ベースはこんな感じですが、さらにあとでデータが追加された場合に
シート名"send list"
DDD EEE FFF 450   450 ←100があとで追加
DDD EEE GGG 100   100

となるように"send list"にすでにデータがあった場合は合計を変更したいです。
シート名"Shipped"の表は積み上げ式の表ですので、追記以外変更はありません。
目的はDDD EEE FFF は注文が400に対し完了が350となった場合に100足りないことになります。するとまだすべて完了していないことがわかります。
あとで"Shipped"に完了データが追加されて再計算することですべて終了しているかしていないかが判断できるプログラムにしたいです。

ながながと書きましたが、お助けください。宜しくお願い申し上げます。

【74042】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/9(火) 17:37 -

引用なし
パスワード
   ▼nonoka さん:

こんにちは

転記先のシート上の場所が不明ですが想像で。
転記前に、転記先の書き込み領域のクリアをしておいたほうがいいのですが
手を抜いています。

Sub Sample()
  Dim dic As Object
  Dim c As Range
  Dim v() As Variant
  Dim z As Long
  Dim key As String
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  With Sheets("Shipped")
    z = .Range("D" & .Rows.Count).End(xlUp).Row - 9 'データ行数
    ReDim v(1 To z, 1 To 7) '転記用配列。行数は最大可能行数
    For Each c In .Range("D10").Resize(z)
      key = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab)
      If Not dic.exists(key) Then dic(key) = dic.Count + 1 '配列行番号
      i = dic(key)
      v(i, 1) = c.Value
      v(i, 2) = c.Offset(, 1).Value
      v(1, 3) = c.Offset(, 2).Value
      v(i, 4) = c.Offset(, 3).Value
      v(i, 7) = v(i, 7) + c.Offset(, 6).Value
    Next
  End With
  
  With Sheets("send list")
    .Range("D10").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    .Select
  End With
  
End Sub

【74043】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/9(火) 17:40 -

引用なし
パスワード
   ▼nonoka さん:

↑ コードで1行、タイプミスがありました。

×)v(1, 3) = c.Offset(, 2).Value

○)v(i, 3) = c.Offset(, 2).Value

【74045】Re:4列一致したものを集めて集計
質問  nonoka  - 13/4/9(火) 18:11 -

引用なし
パスワード
   ▼UO3 さん:
自己解決出来ました!
下記に最終落着きました。ありがとうございました。

基本的なことで申し訳ありませんが、E列とF列の数字を比べて違っていれば
F列の数字を太字の赤字に表示したいです。
表の開始は5行目からです。
シート自体にこれを設定したいです。宜しくお願いします。


Sub 実績計算()

  Dim dic As Object
  Dim c As Range
  Dim v() As Variant
  Dim z As Long
  Dim key As String
  Dim i As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  With Sheets("Shipped")
    z = .Range("D" & .Rows.Count).End(xlUp).Row - 9 'データ行数
    ReDim v(1 To z, 1 To 7) '転記用配列。行数は最大可能行数
    For Each c In .Range("D10").Resize(z)
      key = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab)
      If Not dic.exists(key) Then dic(key) = dic.Count + 1 '配列行番号
      i = dic(key)
      v(i, 1) = c.Value
      v(i, 2) = c.Offset(, 1).Value
      v(i, 3) = c.Offset(, 2).Value
      v(i, 4) = c.Offset(, 3).Value
      v(i, 5) = v(i, 5) + c.Offset(, 6).Value
    Next
  End With
 
  With Sheets("send list")
    .Range("B5").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    .Select
  End With
 
End Sub

【74046】Re:4列一致したものを集めて集計
質問  nonoka  - 13/4/9(火) 18:30 -

引用なし
パスワード
   ▼UO3 さん:

最初のトピの質問の下記部分の処理を追加したいです。

>シート名"send list"G列は上の処理でJ列に数字が入ればE列−F列の計算結果をG列に記入したいです。

【74047】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/9(火) 19:54 -

引用なし
パスワード
   ▼nonoka さん:

E,Fの計算と色つけについては、後ほど(明日になるかも)
アップしたコードを、ご自分で実際のレイアウトにチューニングして
仕上げられたこと、敬服。拍手!!です。

ところで、実際の転記側レイアウトは5列なんですね。
転記コードはOKですが、配列自体が
ReDim v(1 To z, 1 To 7) '転記用配列。行数は最大可能行数
と、7列規定されています」なので、からっぽの6列目、7列目も転記されます。

ReDim v(1 To z, 1 To 5) '転記用配列。行数は最大可能行数

このようにしておきましょう。

【74048】Re:4列一致したものを集めて集計
回答  nonoka  - 13/4/9(火) 20:30 -

引用なし
パスワード
   ▼UO3 さん:
なるほど、出来ました!
G列の計算と、赤色太字は計算式や条件付き書式で簡単にできるのですが、ファイルが重くなってしまいますので、よろしくお願いします。

【74049】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/9(火) 21:16 -

引用なし
パスワード
   ▼nonoka さん:

こんばんは

質問です。

>J列に数字が入ればE列−F列の計算結果をG列に記入したいです。

ここでいう J列は Shipped のJ列ですよね?
で、「数字が入れば」ということは、空白であれば(あるいは 0)
計算しないということですか?

それと、E列−F列の計算結果をG列に記入

これは send list の列ですね?
アップしたコードは E列は「キー」だと思っていましたので、
F列は合計値ですが、E列は、Shipped の G列のままの数字にしています。
E列もShipped の G列の合計にしなければいけないのでしょうか?

でも、そうすると、Shipped の G 列はキーですから、その前の3列が同じでも
分かれますよね。
ということは、転記時 G列を合計してE列に転記すると、

AAAA BBBB CCCC 1000 800 (もとのG列は 100 だった。これが10行あった)
AAAA BBBB CCCC 1000 700(もとのG列は 500 だった。これが2行あった)

なんだか、わかりにくくないですか?

で、そうではなく、

AAAA BBBB CCCC 100 800
AAAA BBBB CCCC 500 700

だとすると、この100 や 500 という値から 合計値である F列の800や700を引くことになり、
それはそれで、へんだなぁと思うのですが。

【74050】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/10(水) 11:16 -

引用なし
パスワード
   ▼nonoka さん:

上で質問したことについては想像で。
勘違いあれば指摘願います。

Sub 実績計算2()

  Dim dic As Object
  Dim c As Range
  Dim v() As Variant
  Dim z As Long
  Dim key As String
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")

  With Sheets("Shipped")
    z = .Range("D" & .Rows.Count).End(xlUp).Row - 9 'データ行数
    ReDim v(1 To z, 1 To 5) '転記用配列。行数は最大可能行数
    For Each c In .Range("D10").Resize(z)
      key = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab)
      If Not dic.exists(key) Then dic(key) = dic.Count + 1 '配列行番号
      i = dic(key)
      v(i, 1) = c.Value
      v(i, 2) = c.Offset(, 1).Value
      v(i, 3) = c.Offset(, 2).Value
      v(i, 4) = c.Offset(, 3).Value
      v(i, 5) = v(i, 5) + c.Offset(, 6).Value
    Next
  End With

  With Sheets("send list")
    With .Range("B5").Resize(UBound(v, 1), UBound(v, 2))
      .Value = v
      With .Columns(5).Font
        .ColorIndex = xlAutomatic
        .FontStyle = "標準"
      End With
      For Each c In .Columns(5).Resize(dic.Count).Cells
        If c.Offset(, 1).Value > c.Value Then
          c.Font.Color = vbRed
          c.Font.FontStyle = "太字"
        End If
        c.Offset(, 1).FormulaR1C1 = "=RC[-2]-RC[-1]"
      Next
      .Parent.Select
    End With
  End With

End Sub

【74056】Re:4列一致したものを集めて集計
回答  nonoka  - 13/4/11(木) 8:14 -

引用なし
パスワード
   ▼UO3 さん:
おはようございます。
返信遅くなって申し訳ありません。

>質問です。
>
>>J列に数字が入ればE列−F列の計算結果をG列に記入したいです。
>
>ここでいう J列は Shipped のJ列ですよね?
いえ、"send list"になります。
Shippedは下記コードでOKでした。

あとはsend listでの処理となります。
下記コードでB列からF列に"Shipped"からのデータが集計されました。
"send list"単体での作業で
E列引くF列の計算結果をG列にという意味です。
ですが、一行挿入したので、F引くGはHとしたいです。
G列は手入力で記入しますので、記入した時点でHに数字が入るとしたいです。

計算式をH列に=F-Gといれれば済むことですが、データ量が増加した場合を想定してマクロでおねがいしたいと思います。

U03様はたぶんすごい複雑なことを考えておられたのですね。
書き方がまずかったです。申し訳ありません。

Sub 実績計算()

  Dim dic As Object
  Dim c As Range
  Dim v() As Variant
  Dim z As Long
  Dim key As String
  Dim i As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  With Sheets("Shipped")
    z = .Range("D" & .Rows.Count).End(xlUp).Row - 9 'データ行数
    ReDim v(1 To z, 1 To 5) '転記用配列。行数は最大可能行数
    For Each c In .Range("D10").Resize(z)
      key = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab)
      If Not dic.exists(key) Then dic(key) = dic.Count + 1 '配列行番号
      i = dic(key)
      v(i, 1) = c.Value
      v(i, 2) = c.Offset(, 1).Value
      v(i, 3) = c.Offset(, 2).Value
      v(i, 4) = c.Offset(, 3).Value
      v(i, 5) = v(i, 5) + c.Offset(, 6).Value
    Next
  End With
 
  With Sheets("send list")
    .Range("B5").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    .Select
  End With
 
End Sub

【74057】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/11(木) 10:32 -

引用なし
パスワード
   ▼nonoka さん:

こんにちは

まず、これでOKですという、そちらの Sub 実績計算() ですけど、
私がアップした Sub 実績計算2() では send list の G列に E列 - F列 の式がはいるのですが
それを消しておられますね?
これは、残さなきゃいけないのでは?

このあたり、私の勘違いがあるのでしょうか?
ちょっと、わかりにくいのですが?

で、あらためて、send list 側で J 列に数字が入った時に H列に F列 - G列 の式を入れる
(あるいは計算結果の値をいれる?)ということなのではないでしょうか?

>E列引くF列の計算結果をG列にという意味です。
>ですが、一行挿入したので、F引くGはHとしたいです。

一行は一列の間違いだとして、どこで挿入されたのでしょう?
いずれにしても、実績計算では、式をセットしないということなのでしょうか?

・実績計算では式をセットせず、send list で J 列に数字が入ったときに
 H列にF-Gの計算式をいれる? でも、この時点で、G列は空白ですけど?
・それとも、実績計算でも、私の実績計算2 でやっているように G列に E列 - F列の式をいれておいて
 あらためて、send list側でJ列(ですか?)に数字が入ったら、H列に F列 - G列の式をいれる?
 (この式は結果的には E列 - G列と同じだと思いますが)
・それとも・・・?

あと、send listのJ列に数字が入ったらという意味は
数字以外の入力(空白含めて)の場合は H列をクリアするということなのでしょうか?

【74058】Re:4列一致したものを集めて集計
回答  nonoka  - 13/4/11(木) 14:41 -

引用なし
パスワード
   ▼UO3 さん:
最新コード確認しました。
問題点1.
赤字の太字の条件が少し違うように思います。
修正しようと思いましたが、今回はわかりませんでした。
シート"send list"のE列とF列を比べFが少なければ赤字の太字
そうでなければ標準書式

問題点2.
G列にE列引くF列となっていますが、
これをF列引くG列としたいです。
G列は手入力で空白の場合があります。

新コードを未確認で返信してしまいもうしわけありませんでした。

【74061】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/12(金) 0:03 -

引用なし
パスワード
   ▼nonoka さん:

問題点1の指摘はそうですね。
比較列に勘違いがありました。

問題点2については、まだよく理解できません。
どのタイミングで式をセットするのかも不明です。
(Shipped から send list に書き込んだ時なのか、あるいは別のタイミングなのか)
また、F-G の式をセットする列は? H列ですか?

前スレでいくつか疑問に思うところをコメントしました。
それらに対する回答をいただきたいですね。

【74062】Re:4列一致したものを集めて集計
回答  nonoka  - 13/4/12(金) 8:52 -

引用なし
パスワード
   ▼UO3 さん:
下記追記します。
>
>質問です。
>
>>J列に数字が入ればE列−F列の計算結果をG列に記入したいです。
>
>ここでいう J列は Shipped のJ列ですよね?
これはsend listでG列のまちがいでした。
>で、「数字が入れば」ということは、空白であれば(あるいは 0)
>計算しないということですか?
計算しなくていいです。G列に数字が入った時だけ計算します。

>それと、E列−F列の計算結果をG列に記入
うえで訂正してます。
>これは send list の列ですね?
そうです。
>アップしたコードは E列は「キー」だと思っていましたので、
>F列は合計値ですが、E列は、Shipped の G列のままの数字にしています。
>E列もShipped の G列の合計にしなければいけないのでしょうか?
>
>でも、そうすると、Shipped の G 列はキーですから、その前の3列が同じでも
>分かれますよね。
>ということは、転記時 G列を合計してE列に転記すると、
>
>AAAA BBBB CCCC 1000 800 (もとのG列は 100 だった。これが10行あった)
>AAAA BBBB CCCC 1000 700(もとのG列は 500 だった。これが2行あった)
>
>なんだか、わかりにくくないですか?
たぶんここで、勘違いされています。
AAAA BBBB CCCC 1000 100 これが10行あった。
それを
AAAA BBBB CCCC 1000 1000 となります。
前のAAAAから1000までは10行とも同じになります。
変わるのはJ列の合算値だけになります。

【74063】Re:4列一致したものを集めて集計
発言  UO3  - 13/4/12(金) 9:53 -

引用なし
パスワード
   ▼nonoka さん:

おはようございます。
まだ、勘違いがあるかもしれません。
コード記述としては、できる限り、【列記号】で書きましたので
列の勘違いがあれば修正願います。
式は、H列にセットしていますが、最初は空白の結果になります。
コード実行後、G列に何か値がはいれば、引き算の結果がH列に表示されます。

Sub 実績計算3()

  Dim dic As Object
  Dim c As Range
  Dim v() As Variant
  Dim z As Long
  Dim key As String
  Dim i As Long
  Dim n As Long
  
  Set dic = CreateObject("Scripting.Dictionary")

  With Sheets("Shipped")
    z = .Range("D" & .Rows.Count).End(xlUp).Row - 9 'データ行数
    ReDim v(1 To z, 1 To 5) '転記用配列。行数は最大可能行数
    For Each c In .Range("D10").Resize(z)
      key = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab)
      If Not dic.exists(key) Then dic(key) = dic.Count + 1 '配列行番号
      i = dic(key)
      v(i, 1) = c.Value
      v(i, 2) = c.Offset(, 1).Value
      v(i, 3) = c.Offset(, 2).Value
      v(i, 4) = c.Offset(, 3).Value
      v(i, 5) = v(i, 5) + c.Offset(, 6).Value
    Next
  End With

  With Sheets("send list")
  
    n = UBound(v, 1)    '行数
    
    .Range("B5").Resize(n, UBound(v, 2)).Value = v
    With .Range("F5").Resize(n).Font
      .ColorIndex = xlAutomatic
      .FontStyle = "標準"
    End With
    
    For Each c In .Range("F5").Resize(dic.Count, UBound(v, 2))
      With c.EntireRow
        If .Range("F1").Value < .Range("E1").Value Then
          .Range("F1").Font.Color = vbRed
          .Range("F1").Font.FontStyle = "太字"
        End If
      End With
    Next
    
    .Range("H5").Resize(dic.Count).Formula = "=IF(G5=0,"""",F5-G5)"
    .Select
    
  End With

End Sub

【74084】Re:4列一致したものを集めて集計
お礼  nonoka  - 13/4/17(水) 18:23 -

引用なし
パスワード
   ▼UO3 さん:
返信遅くなり申し訳ありません。
少し改良しましたが、無事完了出来ました。
ありがとうございました。
ほんとにいつも助かっております。
また、おせわになると思いますが宜しくお願い致します!!

1489 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free