[[20200803175026]] 『条件を満たしたとき、行の追加』(テレワーク最高) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『条件を満たしたとき、行の追加』(テレワーク最高)

良い方法があればご教示ください。

現在、

   A    B   C    D    E
 都道府県 支店名 支社名 担当顧客 請求額

1北海道   札幌  第一課  
2北海道   札幌  第二課  
3北海道   札幌  第三課  
4北海道   札幌  第四課  
5北海道   旭川  第一課

       ・
       ・
       ・

と、全国の支店名と課支社名が入力されているシートがあります。
そこに、

   A    B   C    D    E
 都道府県 支店名 支社名 担当顧客 請求額

1北海道   札幌  第一課  ○○  10,000
2北海道   札幌  第一課  ××  20,000
3北海道   札幌  第一課  △△  30,000
4北海道   札幌  第三課  ■■  15,000
5北海道   旭川  第三課  □□  25,000

と、支社ごとの顧客の請求が入った別の表を突合せするを行いたいです。
この際、元の表の順番は変えず、該当0の場合には、何も反映させずにそのまま、1つ該当がある場合には、その情報を転記、複数該当の場合には、1つ目に該当した行の下に行の挿入を行い転記といったような感じで、複数該当の際だけ行を増やして転記していきたいです。

IF的なものをつかうかと思うのですが、
「条件一致した場合に、該当部分に一行増やして転記」とするには、
どのようにコードを書けばいいでしょうか。

皆様のお力をいただけますと助かります。

         

< 使用 Excel:Excel2010、使用 OS:Windows7 >


A〜C列を条件に、フィルターで抽出・転記を繰り返してはどうでしょうか。

(マナ) 2020/08/03(月) 21:26


↑は、こんな流れです
 1)A1〜E1(見出し)をF1〜J1にコピー
 2)A〜C列の2行目を抽出条件として、「別の表」をフィルター
 3)抽出された行を、F〜J列にコピー
 4)抽出されなかったら、A〜C列2行目(抽出条件)を、F〜H列にコピー
 5)2)〜4)を、A〜C列の最終行まで繰り返し
 6)A〜E列を削除

(マナ) 2020/08/03(月) 21:35


〉マナさん

なんとなくイメージはできましたが、マクロが思い付きません。。。
どのようになりますでしょうか?
(テレワーク最高) 2020/08/04(火) 08:18


 どのような結果を求めているのかわかってないですが、たたき台です。
 前提として、「マスターになく データにある」 という場面が無いことが条件です。

 Sheet1(マスター)
    |[A]     |[B]   |[C]   |[D]     |[E]   
 [1]|都道府県|支店名|支社名|担当顧客|請求額
 [2]|北海道  |札幌  |第一課|        |      
 [3]|北海道  |札幌  |第二課|        |      
 [4]|北海道  |札幌  |第三課|        |      
 [5]|北海道  |札幌  |第四課|        |      
 [6]|北海道  |旭川  |第一課|        |      
 [7]|北海道  |旭川  |第三課|        |      

 Sheet2(データ)
    |[A]     |[B]   |[C]   |[D]     |[E]   
 [1]|都道府県|支店名|支社名|担当顧客|請求額
 [2]|北海道  |札幌  |第一課|○○    | 10000
 [3]|北海道  |札幌  |第一課|××    | 20000
 [4]|北海道  |札幌  |第一課|△△    | 30000
 [5]|北海道  |札幌  |第三課|■■    | 15000
 [6]|北海道  |旭川  |第三課|□□    | 25000

 Sheet3(結果) ★事前に項目名だけ手入力で埋めてください
     |[A]     |[B]   |[C]   |[D]     |[E]   |[F]|[G]     |[H]   |[I]   |[J]|[K]     |[L]   |[M]   |[N]     |[O]   
 [1] |都道府県|支店名|支社名|担当顧客|請求額|   |都道府県|支店名|支社名|   |都道府県|支店名|支社名|担当顧客|請求額
 [2] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [3] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [4] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [5] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [6] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [7] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [8] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [9] |        |      |      |        |      |   |        |      |      |   |        |      |      |        |      
 [10]|        |      |      |        |      |   |        |      |      |   |        |      |      |        |      

 出力結果
    |[A]     |[B]   |[C]   |[D]     |[E]   
 [1]|都道府県|支店名|支社名|担当顧客|請求額
 [2]|北海道  |札幌  |第一課|○○    | 10000
 [3]|北海道  |札幌  |第一課|××    | 20000
 [4]|北海道  |札幌  |第一課|△△    | 30000
 [5]|北海道  |札幌  |第二課|        |      
 [6]|北海道  |札幌  |第三課|■■    | 15000
 [7]|北海道  |札幌  |第四課|        |      
 [8]|北海道  |旭川  |第一課|        |      
 [9]|北海道  |旭川  |第三課|□□    | 25000

    Option Explicit
    Sub 消込()
        Dim wsM As Worksheet: Set wsM = Sheets("Sheet1") '★シート名は現状に合わせて修正してください。
        Dim wsD As Worksheet: Set wsD = Sheets("Sheet2")
        Dim wsR As Worksheet: Set wsR = Sheets("Sheet3") '★出力シートは、新しく作成してください。
        Dim i As Long
        Dim lRow As Long
        Dim cnt As Long
        wsR.Range("E2", wsR.Cells(Rows.Count, "A").End(xlUp).Offset(1)).ClearContents
        For i = 2 To wsM.Cells(Rows.Count, "A").End(xlUp).Row
            '==マスターシートから検索条件を転記
            wsR.Range("G2:I2").Value = wsM.Range("A:C").Rows(i).Value

            '==フィルタオプションで対象データの吸い出し
            wsD.Range("A1").CurrentRegion.AdvancedFilter _
                Action:=xlFilterCopy, _
                CriteriaRange:=wsR.Range("G1:I2"), _
                CopyToRange:=wsR.Range("K1:O1"), _
                Unique:=False
            lRow = wsR.Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
            If wsR.Range("K2").Value = "" Then
                '==データが無かった場合、マスタデータの検索条件をそのまま転記
                wsR.Range("A:E").Rows(lRow).Value = wsM.Range("A:E").Rows(i).Value

            Else
                '==データがある場合、検索結果を転記
                cnt = WorksheetFunction.CountA(wsR.Range("K:K")) - 1
                wsR.Range("A:E").Rows(lRow).Resize(cnt).Value = wsR.Range("O2", wsR.Cells(Rows.Count, "K").End(xlUp)).Value
            End If
        Next i
    End Sub

(稲葉) 2020/08/04(火) 11:39


なんとかできそうです!
ありがとうごさいました!
(テレワーク最高) 2020/08/04(火) 14:58

 別案で、こんな方法はいかがでしょうか。
 ○説明のあったシートを、便宜上、上から"マスター表","データ表"と呼びます。
 ○"データ表"に基づいて、"マスター表"に挿入を繰り返す方法もあると思いますが、
   次のように考えることはできませんか?

 ・"マスター表"に識別コード(都道府県,支店名,支社名による連番)列を追加。昇順となるように設定。
 ・"データ表"にも上記に基づく識別コードを追加。
 ・"マスター表"にあって、"データ表"にないものを"マスター表"から抽出して、"データ表"の最後に追加。
 ・"データ表"を識別コードでソートする。

 Sub test()
     Dim wsM As Worksheet, ws As Worksheet
     Dim dicM As Object, dic As Object
     Dim k&, s$, e, nextRow&

     Set wsM = Worksheets("Sheet1")  ' 以下、"マスター表"と呼ぶ
     Set ws = Worksheets("Sheet2")   ' 以下、"データ表"
     Set dicM = CreateObject("Scripting.Dictionary")
     Set dic = CreateObject("Scripting.Dictionary")

     '"マスター表"のF列に連番を付与。
     For k = 2 To wsM.Cells(Rows.count, "A").End(xlUp).Row
         s = wsM.Cells(k, "A") & wsM.Cells(k, "B") & wsM.Cells(k, "C")
         dicM(s) = k
         wsM.Cells(k, "F") = k
     Next

     '"データ表"のF列に、対応する連番をセット
     For k = 2 To ws.Cells(Rows.count, "A").End(xlUp).Row
         s = ws.Cells(k, "A") & ws.Cells(k, "B") & ws.Cells(k, "C")
         dic(s) = Empty
         ws.Cells(k, "F") = dicM(s)
     Next

     '"データ表"にない、"マスター表"のデータを"データ表"の最後に追加
     For Each e In dicM
         If Not dic.exists(e) Then
             nextRow = ws.Cells(Rows.count, "A").End(xlUp).Row + 1
             wsM.Cells(dicM(e), "A").Resize(1, 6).Copy ws.Cells(nextRow, "A")
         End If
     Next

     '連番でソート
     ws.Range("A1").CurrentRegion.Sort Key1:=ws.Range("F1"), Order1:=xlAscending, Header:=xlYes
     ws.Columns("F").Clear
 End Sub

(γ) 2020/08/04(火) 17:35


>稲葉san

すいません、追加で教えていただけだると。。。。
教えていただいたコードを活用し、無事うまくいきました!

ただ、今度は下記のように条件を追加することになってしまいまして、
教えていただkると。。。

【条件】
・担当顧客のうち、5件の請求があったものを1カウントとし、マスター表に登録。
 F列には5件到達の請求日を記載。
・10件以上になった際には、5件以上で1行記載している行の下に行を追加し、
 再度件数に「5」と記載し、F列には10件到達の請求日を記載。
 (5件の行が2行になる)

Sheet1(マスター)

    |[A]     |[B]   |[C]   |[D]     |[E]    |  [F]
 [1]|都道府県|支店名|支社名|担当顧客|請求額 |  請求日    
 [2]|北海道  |札幌  |第一課|        |       |      
 [3]|北海道  |札幌  |第二課|        |       |      
 [4]|北海道  |札幌  |第三課|        |      |      
 [5]|北海道  |札幌  |第四課|        |      |      
 [6]|北海道  |旭川  |第一課|        |       |      
 [7]|北海道  |旭川  |第三課|        |       |  

 Sheet2(データ)
    | [A]     |[B]   |[C]   |[D]     |[E]    |[F]            
 [1]| 都道府県|支店名|支社名|担当顧客|請求額 | 4/1     
 [2]| 北海道  |札幌  |第一課|○○    | 10000 | 4/2     
 [3]| 北海道  |札幌  |第一課|○○    | 20000 | 4/3     
 [4]| 北海道  |札幌  |第一課|○○    | 30000 | 4/4     
 [5]| 北海道  |札幌  |第一課|○○    | 15000 | 4/5     
 [6]| 北海道  |札幌  |第一課|○○    | 25000 | 4/6
 [7]| 北海道  |札幌  |第三課|××    | 10000 | 4/2     
 [8]| 北海道  |札幌  |第三課|××    | 20000 | 4/3     
 [9]| 北海道  |札幌  |第三課|××   | 30000 | 4/4     
 [10]|北海道  |札幌  |第三課|××    | 15000 | 4/5     
 [11]|北海道  |札幌  |第三課|××    | 25000 | 4/6

 出力結果
    | [A]     |[B]   |[C]   |[D]     |[E]    |[F]            
 [1]| 都道府県|支店名|支社名|担当顧客|件数 | 請求日    
 [2]| 北海道  |札幌  |第一課|○○    | 5  | 4/5
 [3]| 北海道  |札幌  |第二課|      | 0  |      
 [3]| 北海道  |札幌  |第三課|××    | 5  | 4/6     
 [8]| 北海道  |札幌  |第四課|      | 0  |     
 [9]| 北海道  |旭川  |第一課|△△   | 5  | 4/10     
 [10]|北海道  |旭川  |第二課|△△   | 5  | 4/20     
 [11]|北海道  |旭川  |第三課|      | 0  |  

↑イメージとしてはこんな感じです。
よろしくお願いします。

(テレワーク最高) 2020/08/04(火) 21:20


 前提:自分でやる気がなさそうだし、説明も苦手そうなので、下記の内容がはっきりしなかった場合、下ります。

 説明もわからんし、データと結果が不整合なので答えようがないです。
 また全く違う案件なので、0からの作り直しになります。
 集計だけなら計算式だけで可能です。

 >担当顧客のうち、5件の請求があったものを1カウントとし、マスター表に登録
 1)担当顧客と支社名の関係がわからない。
 2)データにあって、マスターにないものもある?

 >F列には5件到達の請求日を記載。 
 3)仮に札幌第一課の○○を見ても、5件到達は4/6ではないのか?
 4)データは日付で昇順になっているのか?

 >10件以上になった際には、5件以上で1行記載している行の下に行を追加し、
 >再度件数に「5」と記載し、F列には10件到達の請求日を記載。 
 > (5件の行が2行になる) 
 5)そんな意味不明な表作るつもりはない。
   7件なら、5と2なのか? 12件なら5と5と2なのか?

   
(稲葉) 2020/08/05(水) 08:19

>稲葉さん

わかりにくい説明ですいません。

1)支社ごとに紐づいている顧客がおり、支社ごとに顧客が複数いる形になります。
  データ上、支社に紐づく顧客が0件でも支社としての行は残し、顧客名などはブランクもしくは
  0表記になります。  

2)もともとのデータには請求金額があるのですが、今回集計したいのは件数だけになります。
  なので、請求金額欄はなくても大丈夫ですので、出力結果に合わせてマスターとデータは
  一致させられます。

3)確かに、5件到達日は4/6でした。記載誤りです。申し訳ございません。

4)元データは、日付での並び替えは行われておらず、バラバラです。

5)5件の場合と10件の場合以外は、出力しません。出力結果としては0になります。
  ・5件未満の場合→支社としての行はあるものの、顧客名などはブランクもしくは0
  ・5件以上10件未満の場合(1顧客のみ)→該当支社欄に記載。件数は5件。
  ・5件以上10件未満の場合(複数顧客)→該当支社欄を追加し、記載。件数は5件。
  ・10件以上の場合(1顧客のみ)→該当支社欄に記載。件数は5件。(5件到達日を記載)
  ・10件以上の場合(複数顧客)→該当支社欄を追加し、記載。件数は5件ずつ2行にし、
   それぞれ、5件到達日、10件到達日を記載。
  ・15件以上の場合でも、3行以上にする必要はなし。

このような形になります。

(テレワーク最高) 2020/08/05(水) 09:34


 データと整合がとれ、すべての要件を満たす表作ってもらえませんか?
 実際に手作業でやっている仕事ですよね?

 顧客ごとの集計か、支社ごとの集計か
 札幌第一課で顧客が2人いたとして、合算なのか、顧客ごとなのか
 顧客ごとであればどのように出力したいのか
 日付がバラバラなら、どのように数えていくのか

 ピボットテーブルではだめなんですか?
(稲葉) 2020/08/05(水) 10:37

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.