ここから本文です

こんにちは。

neg********さん

2018/11/214:21:39

こんにちは。

以前は、ありがとうございました。

教えて頂いたマクロを応用して使用したかったのですが、理解出来ず困っています。

お時間ある時にでも、よろしくお願い致します。

以下、以前に投稿した内容です。↓↓↓

エクセルについて質問です。
添付した画像のような処理ができるマクロを教えて頂きたいです。

店舗毎の出荷数量の明細をパターン順に並べ替え、それぞれのパターンの店舗数を出したいです。
※G列のパターンにはパターン名として数字を入れています。

※合計が同じでも、明細が違う物があるため、明細含め、全てが一致した物を同一パターンとして並べ替えをお願いします。

よろしくお願い致します。
(添付画像は、以前に投稿した物です)

↑↑↑
実際の表は、店コードが入っているA列はそのままで、対象の範囲は、A5~VB1005になります。(合計欄はVB列です)

よろしくお願い致します。

Rows.Count,VB1005,Then Exit For,パターン,vWj As Variant,vWi As Variant,VA1&quot

閲覧数:
59
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

30246kikuさん

2018/11/217:03:07

以前のご質問は以下でしたね

エクセルについて質問です。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q111979774...

今回の表は、行・列数が結構多いですね・・・

※ 以下未実行で、おかしくなったらごめんなさい
前回 Samp1 からの変更部分に ★ 付けておきました

※ この方法じゃ時間かかるかも・・・・
で、処理順をチョッと変更した Samp3 は・・・

どうなりますか


Public Sub Samp2()
   Dim v As Variant, vWi As Variant, vWj As Variant
   Dim i As Long, j As Long, k As Long, n As Long

   Application.ScreenUpdating = False
   With ActiveSheet
      With .Range("A5", .Cells(Rows.Count, "A").End(xlUp)) ' ★
         With .Resize(, Range("VD1").Column) ' ★
            Application.Calculation = xlCalculationManual
            For j = 2 To Range("VB1").Column ' ★
               .Sort .Cells(j), xlDescending, Header:=xlNo
            Next
            Application.Calculation = xlCalculationAutomatic

            .Columns("VC:VD").ClearContents ' ★
            i = 1: n = 1
            While (i <= .Rows.Count)
               v = .Cells(i, "VB").Value ' ★
               vWi = Join(WorksheetFunction.Index( _
                  .Rows(i).Range("B1:VA1").Value, 1, 0), vbTab) ' ★
               For j = i + 1 To .Rows.Count
                  If (.Cells(j, "VB").Value <> v) Then Exit For ' ★
                  vWj = Join(WorksheetFunction.Index( _
                     .Rows(j).Range("B1:VA1").Value, 1, 0), vbTab) ' ★
                  If (vWi <> vWj) Then Exit For
               Next
               .Cells(i, "VD").Value = j - i ' ★
               For k = i To j - 1
                  .Cells(k, "VC") = n ' ★
               Next
               n = n + 1
               i = j
            Wend
         End With
      End With
   End With
   Application.ScreenUpdating = True
End Sub


Public Sub Samp3()
   Dim v As Variant, vWi As Variant, vWj As Variant
   Dim i As Long, j As Long, k As Long, n As Long

   Application.ScreenUpdating = False
   With ActiveSheet
      With .Range("A5", .Cells(Rows.Count, "A").End(xlUp)) ' ★
         With .Resize(, Range("VD1").Column) ' ★
            Application.Calculation = xlCalculationManual
            For j = 2 To Range("VB1").Column ' ★
               .Sort .Cells(j), xlDescending, Header:=xlNo
            Next
            Application.Calculation = xlCalculationAutomatic

            .Columns("VC:VD").ClearContents ' ★
            i = 1: n = 1
            vWi = Join(WorksheetFunction.Index( _
               .Rows(i).Range("B1:VA1").Value, 1, 0), vbTab) ' ★
            While (i <= .Rows.Count)
               v = .Cells(i, "VB").Value ' ★
               For j = i + 1 To .Rows.Count
                  vWj = Join(WorksheetFunction.Index( _
                     .Rows(j).Range("B1:VA1").Value, 1, 0), vbTab) ' ★
                  If (.Cells(j, "VB").Value <> v) Then Exit For ' ★
                  If (vWi <> vWj) Then Exit For
               Next
               .Cells(i, "VD").Value = j - i ' ★
               For k = i To j - 1
                  .Cells(k, "VC") = n ' ★
               Next
               n = n + 1
               i = j
               vWi = vWj
            Wend
         End With
      End With
   End With
   Application.ScreenUpdating = True
End Sub

  • 質問者

    neg********さん

    2018/11/217:54:51

    ご対応ありがとうございます。
    Samp3でテストしましたが、スピードは問題無く動きました。
    ただ・・・実は、B列とC列に店舗名が入っておりまして、それが原因で、同じパターンでも、違うパターンだと判断してしまいます。
    その2列だけ対象から外して頂けると助かるのですが…。
    なんとかなりますでしょうか?

  • その他の返信(2件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2018/11/5 08:52:03

ありがとうございます。
理想の物ができました。
助かりました。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる