戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
EXCEL2016 個数の把握について

    [189513] EXCEL2016 個数の把握について-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ とっこ -(2019/06/11(22:29))
    □U R L/
      お世話になります
      
      出庫した数に対して、どれくらい返却になっているのかを
      店舗毎と数量で把握したいと思います
       
      
      D列に店舗名、E列に出庫数、G列に店舗名、H列に入庫数
      
      があります
      
      店舗に物品を出庫して、その出庫した数量を、
      
      後日店舗から返却(入庫)がありますが、入庫日がマチマチです
      
      店舗への出庫数の合計を、入庫数から確認して、
      
      出庫数に満たない場合Asheet2にその店舗名と残数を書き出したいと思います
      
      データは5行目から始まります
      
      最下行は不定です
      
      
      D5にQQQ、E5に500 G5にABC、H5に10
      
      D6にYKH、E6に50  G6にHND、H6に25
      
      D7にANA、E7に20   G7にABC、H7に10
      
      D8にYKH、E8に50   G8にHND、H8に25
      
      D9にABC、E9に5    G9にQQQ、H9に250
      
      D10にQQQ、E10に25 G10にYKH、H10に50
      
      とあるとします
      
      残数(未返却数)は下記になります
      
      QQQ 275
      
      YKH 50
      
      ANA 20
      
      ABC 5
      
      あくまでも、D列とE列にある店舗名への出庫が、
      
      どれくらい返却(入庫)されているのかをVBAで把握したいです
      
      ご教示ください
      
      長文を最後まで読んで頂きありがとうございました
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



      ++++++++++++++++++++
      OS      ⇒OTHER
      Version⇒OTHER
      ++++++++++++++++++++




    [189514] Re[1]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ apple -(2019/06/12(09:31))
    □U R L/
      >出庫数に満たない場合
      入庫数が出庫数より多い場合は、入庫数を無視して出庫数を書き出す という事ですよね。
      
      Collection オブジェクトを使っています。
      
      Sub Sample()
          Dim c As Range
          Dim Col As Collection
          Dim R1 As Range, R2 As Range
          Dim s As Long, n As Long
          Dim i As Long
          
          Set Col = New Collection
          With Worksheets("Sheet1") ' データは "Sheet1" の 5 行目以降と想定
              ' 出庫データの店舗名範囲を変数 R1 に参照取得
              Set R1 = .Range("D5", .Range("D" & .Rows.Count).End(xlUp))
          End With
          Set R2 = R1.Offset(, 3) ' 入庫データの店舗名範囲を変数 R2 に参照取得,
          For Each c In R1 ' 出庫データの店舗名範囲をループ
              On Error Resume Next
              ' Col オブジェクトに要素を追加
              Col.Add c.Value, c.Value ' 追加しようとするキー(店舗名)が重複しているとエラーが発生
              If Err.Number = 0 Then ' エラーが発生していない場合(ユニークな店舗名の場合処理)
                  s = WorksheetFunction.SumIf(R1, c.Value, R1.Offset(, 1)) ' 出庫総数を計算
                  n = WorksheetFunction.SumIf(R2, c.Value, R2.Offset(, 1)) ' 入庫総数を計算
                  If s < n Then  ' 出庫数が入庫数未満の場合
                      n = 0 ' 入庫数を 0 とみなす
                  End If
                  'MsgBox c.Value & " の残数は " & s - n
                  i = i + 1
                  Worksheets("Sheet2").Range("A" & i).Value = c.Value ' A 列に店舗名
                  Worksheets("Sheet2").Range("B" & i).Value = s - n   ' B 列に残数
              End If
              On Error GoTo 0
          Next
          Set Col = Nothing
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189515] Re[2]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ とっこ -(2019/06/12(09:57))
    □U R L/
      apple様
      ありがとうございます
      二点ございます
      
      出庫に対して入庫が0になったらAsheet2に店舗と残数を表示しないようにしたいです
      
      出庫がなくて、入庫のみの場合もありますが、その場合計算されませんので、計算できるようにしたいです
      宜しくお願い申し上げます
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189516] Re[3]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ apple -(2019/06/12(10:20))
    □U R L/
      わたしは
      
      >出庫数に満たない場合
      入庫数が出庫数より多い場合は、入庫数を無視して出庫数を書き出す
      
      という想定でコードを書きました。
      
      >出庫がなくて、入庫のみの場合もありますが、その場合計算されませんので・・・
      ↑ は先にあげたわたしの想定では、それを無視するという事になってしまいます。
      
      >出庫に対して入庫が0になったらAsheet2に店舗と残数を表示しないようにしたいです
      意味がわかりかねます。
      
      どういう結果になればいいのかを、その元データとともに例示して下さい。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189517] Re[4]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ とっこ -(2019/06/12(13:22))
    □U R L/
      
      apple様
      
      回答ありがとうございます
      
      以下、補足させてもらいます
      
      D5にQQQ、E5に500、G5にABC、 H5に10
      
      D6にYKH、E6に50、 G6にHND、 H6に25
      
      D7にANA、E7に20、 G7にABC、 H7に10
      
      D8にYKH、E8に50、 G8にQQQ、 H8に500
      
      D9にABC、E9に5、 G9は空白、H9は空白
      
      D10は空白、E10は空白、G10はABC、H10は3
      
      D11は空白、E11は空白、G11はYKH、H11は50
      
      D12は空白、E12は空白、G12はXYZ、H12は500
      
      
       
      
      とします
      
      QQQは0なのでAsheet2には表示させません                                               
      
      YKH      100        ⇒50になります              
      
      ANA      20                                     
      
      ABC       5            ⇒2になります                
      
      データとして出庫だけ、入庫だけの場合があります
      出庫だけの場合もありますし、入庫だけの場合もございます
      
      あいまいに質問をしてしまい、申し訳ございませんでした
      
      よろしくお願い致します                                          
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189518] Re[5]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ apple -(2019/06/12(13:55))
    □U R L/
      そのデータの場合ですが
      
      >QQQは0なのでAsheet2には表示させません
      QQQ について、出庫が合計 500(D5にQQQ、E5に500)、入庫が合計 500(G8にQQQ、 H8に500)
      と 出庫 - 入庫 = 0 だから「表示させません」なのですよね。
      
      ABC について、出庫が合計 5(D9にABC、E9に5)、
             入庫が合計 13(G5にABC、 H5に10、G10はABC、H10は3)
      なのですが、残数が 5 → 2 とするのはどういう根拠ですか?
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189519] Re[6]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ とっこ -(2019/06/12(14:05))
    □U R L/

      apple様

      出庫が先だからです
      出庫よりも前に入庫があるためで
      5-3で2 になります




    [189520] Re[7]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ apple -(2019/06/12(15:13))
    □U R L/
      >出庫が先だからです
      わかりました。以下で試してみて下さい。
      
      Sub Sample_2()
          Dim c As Range
          Dim Col As Collection
          Dim R1 As Range, R2 As Range, R3 As Range
          Dim S As Long, N As Long
          Dim i As Long
          
          Set Col = New Collection
          With Worksheets("Sheet1") ' データは "Sheet1" の 5 行目以降と想定
              ' 出庫データの店舗名範囲を変数 R1 に参照取得
              Set R1 = .Range("D5", .Range("D" & .Rows.Count).End(xlUp))
              ' 入庫データの店舗名範囲を変数 R2 に参照取得
              Set R2 = .Range("G5", .Range("G" & .Rows.Count).End(xlUp))
          End With
          Worksheets("Sheet2").Range("A:B").ClearContents ' "Sheet2" の A:B 列を最初に消去
          For Each c In Union(R1, R2) ' 出庫と入庫の店舗名範囲をループ(入庫だけの場合も計算という要望より)
              If c.Value <> "" Then ' 店舗名セルが空白以外の場合だけ処理
                  On Error Resume Next
                  ' Col オブジェクトに要素を追加
                  Col.Add c.Value, c.Value ' 追加しようとするキー(店舗名)が重複しているとエラーが発生
                  If Err.Number = 0 Then ' エラーが発生していない場合(ユニークな店舗名の場合処理)
                      If Intersect(c, R2) Is Nothing Then ' 出庫データとして店舗名が存在する場合
                          S = WorksheetFunction.SumIf(R1, c.Value, R1.Offset(, 1)) ' 出庫総数を計算
                          ' 入庫データの計算範囲を再定義 その店舗データ以降の範囲とする(先データ除外)
                          Set R3 = Excel.Range(c.Offset(, 3), R2.Cells(R2.Cells.Count))
                          N = WorksheetFunction.SumIf(R3, c.Value, R3.Offset(, 1)) ' 入庫総数を計算
                      Else ' 入庫データ範囲に店舗名が存在する場合(入庫だけの場合も計算という要望より)
                          S = 0 ' 出庫データ範囲に店舗名が無いのだから 0 である
                          N = WorksheetFunction.SumIf(R2, c.Value, R2.Offset(, 1)) ' 入庫総数を計算
                      End If
                      If S = 0 Then ' 出庫数が 0 の場合
                          ' 何もしない(出力しない)
                      Else          ' 出庫数が 0 以外の場合
                          If S < N Then  ' 出庫数が入庫数未満の場合
                              N = 0 ' 入庫数を 0 とみなす
                          End If
                          If S <> N Then ' 出庫数と入庫数が異なる場合のみ出力
                              i = i + 1
                              Worksheets("Sheet2").Range("A" & i).Value = c.Value ' A 列に店舗名
                              Worksheets("Sheet2").Range("B" & i).Value = S - N   ' B 列に残数
                          End If
                      End If
                  End If
                  On Error GoTo 0
              End If
          Next
          Set Col = Nothing
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189521] Re[8]: EXCEL2016 個数の把握について-

    記事引用/メール受信=OFF■

    □投稿者/ ぴんく -(2019/06/12(15:18))
    □U R L/
      参考に
      Sub Test()
          Dim myDic As Object, d As Variant
          Dim LastRow As Long, i As Long, j As Long
          Dim Str As String
          
          Set myDic = CreateObject("Scripting.Dictionary")
          With Worksheets("Sheet1")
              LastRow = Application.Max(.Cells(Rows.Count, "D").End(xlUp).Row, _
                      .Cells(Rows.Count, "G").End(xlUp).Row)
              For i = 5 To LastRow
                  Str = .Cells(i, "D").Value
                  If Str <> "" Then myDic(Str) = myDic(Str) + .Cells(i, "E").Value
                  Str = .Cells(i, "G").Value
                  If Str <> "" Then myDic(Str) = myDic(Str) - .Cells(i, "H").Value
                  If myDic(Str) < 0 Then myDic(Str) = 0
              Next
          End With
          With Worksheets("Sheet2")
              For Each d In myDic.keys
                  If myDic(d) > 0 Then
                      j = j + 1
                      .Cells(j, "A").Value = d
                      .Cells(j, "B").Value = myDic(d)
                  End If
              Next
          End With
          Set myDic = Nothing
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189546] Re[9]: EXCEL2016 個数の把握について-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ とっこ -(2019/06/13(23:12))
    □U R L/

      appleさん
      ぴんくさん

      ありがとうございました
      また、遅くなりまして申し訳ありませんでした

      また、よろしくお願いいたします



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G