• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:EXELで重複しない抽出をするVBAについて)

EXELで重複しない抽出をするVBAについて

jcctairaの回答

  • jcctaira
  • ベストアンサー率58% (119/204)
回答No.4

kyon0512さん   ちょっと意味が理解できていないかも知れません。 1.前回は「○○支店(A)●●支店(B)」と(A),(B)で分けていましたが   今回は「A品(神)A品(東)B品(大)」A品、B品で分けるということでしょうか?   またサンプルではA品は全角のAでB品は半角のBになっていますが、半角の統一で良いのでしょうか?   2.A品(神) A社 A品 7行目~  社内    qqq B品 27行目~  学生    rrr 社員 37行目~  ※20行ならrrrは47行目~ に思うのですが…   3.どうもカッコは青帯がかかるみたいですので  すみません、こちらでは現象が出ません。  かっこ以外に特殊な文字(改行とか)入っていませんか?  ( )ダメなら【 】とか B品(大)→B品ー大ー とかで試してください、   できればkyon0512さんも色々修正して試してくださいね。   Public Sub ユニーク抽出()  Dim Dict  As Object  Dim Key   As Variant  Dim A    As Long  Dim B    As Long  Dim その他 As Long  Dim r    As Long  Dim 本支店 As Variant  Set Dict = CreateObject("Scripting.Dictionary")  With Dict   ' 7行~299行を対象に抽出   For r = 7 To 299    Key = Cells(r, "B") & "::" & Cells(r, "D")    If .Exists(Key) = False Then     .Add Key, ""    End If   Next r   ' 抽出結果を出力   Range("O3:P299").ClearContents   A = 7   B = 27   その他 = 37   For Each Key In .keys    本支店 = Split(Key, "::")(1)    Select Case True     Case InStr(本支店, "A品") >= 1      Cells(A, "O") = Split(Key, "::")(0)      Cells(A, "P") = 本支店      A = A + 1     Case InStr(本支店, "B品") >= 1      Cells(B, "O") = Split(Key, "::")(0)      Cells(B, "P") = 本支店      B = B + 1     Case Else      Cells(その他, "O") = Split(Key, "::")(0)      Cells(その他, "P") = 本支店      その他 = その他 + 1    End Select   Next  End With  Set Dict = Nothing End Sub

kyon0512
質問者

補足

大変お手数をお掛けしております。 済みません前々回の本支店はクリアーにしていただきまして C列に会社名が色々、E列に区分としてA品(神)A品(東)B品(大)として P列とR列にそれぞれ対応した抽出をしたいと思います。 Public Sub ユニーク抽出()  Dim Dict  As Object  Dim Key   As Variant  Dim A品(神)   As Long  Dim A品(東)As Long  Dim B品(大) As Long  Dim r    As Long  Set Dict = CreateObject("Scripting.Dictionary")  With Dict   ' 7行~299行を対象に抽出   For r = 7 To 299    Key = Cells(r, "C") & "::" & Cells(r, "E")    If .Exists(Key) = False Then     .Add Key, ""    End If   Next r   ' 抽出結果を出力   Range("P3:P299","R3:R299").ClearContents   A品(神) = 7   A品(東) = 27   B品(大) = 37   For Each Key In .keys   End Select   Next  End With  Set Dict = Nothing End Sub としましたらDim A品(神)の神とところでコンパイルエラー定数式が必要です。 と出ますので"神"としますと型が一致しませんとでます。 それからDim r は何なんでしょうか? 一応調べましたが・・・。 以上宜しくお願いします。

関連するQ&A

  • 抽出してコピペ 検索すべき文字が存在しない場合は?

    エクセルのマクロを使って、売上帳を作成しています。 下のようなコードで、F2に顧客番号を入れると、売上帳シート内から選んだ顧客のみの売上明細が個別売上帳シートに移るように作っています。 そこで問題なのですが、売上帳シート内に存在しない顧客番号(取引がなかった顧客)を抽出しようとすると、全明細がそっくり抽出されてしまいます。 私としては、その場合は抽出すべきものがないとして、個別売上帳シートは空欄にしてしまいたいのですが、どうすればよいでしょう? 教えてください。 Sub 顧客抽出コピペ() Sheets("売上帳").Select Range("B6").AutoFilter Field:=2, Criteria1:=Range("F2").Value '2つ目のフィルターに検索文字 Range("B5:B2005").Select Selection.Copy Sheets("個別売上帳").Select Range("B5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("売上帳").Select Range("E5:J2005").Select Selection.Copy Sheets("個別売上帳").Select Range("C5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End Sub

  • エクセルでの自動抽出がうまくいきません

    エクセル2000で自動抽出機能を使用しましたが最初の行の項目だけ重複して抽出されます。直す方法はありませんか?自動抽出の方法はデータセルを指定してデータ→フィルタ→フィルタオプションの設定→選択範囲内をデータのセルに指定、指定した範囲を抽出先のセル指定、重複するレコードは無視するにチェックをいれokです。なお上記のマクロは次のようになっています。Sub 商品名の集計() ' ' 商品名の集計 Macro ' マクロ記録日 : 2002/6/30 ユーザー名 : ky ' ' Range("D8:D22").Select Application.CutCopyMode = False Range("D8:D22").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "B26:B36"), Unique:=True Range("A26").Select End Sub 以上よろしくお願いいたします。

  • Excel VBA による特定Recordの抽出

    VBAの初心者です。 各コマンドの意味もよく理解してないため、原因が判りません・・・。 ■特定情報を抽出するVBAの結果が合致しません。  ・Record数が「5000件」あるExcelFileから、Field:3に「1」が入力されているRecordを抽出するVBAを作りました。  ・ExcelsheetでFilterにより抽出するとField:3には「1」が「839件」入力されています。   しかし、実際に作成したVBAを走らせてみると「800件」しか抽出できません。 ■下記が作成したVBAです。 -------------------------------------------- 1)Private Sub task_Select2() Range("F1").Select Selection.AutoFilter Field:=6, Criteria1:="=1", Operator:=xlAnd Rows("3:5503").Select Range("B3").Activate Selection.Delete Shift:=xlUp Selection.AutoFilter Field:=6 ActiveWindow.LargeScroll Down:=-13 Range("B1").Select End Sub 2)Private Sub backup_task2() 'バックアップ用コピー処理 Dim Model As String, fName As String Model = ActiveSheet.Name fName = Model & "_wo" Worksheets(Model).Copy After:=Worksheets(Model) ActiveSheet.Name = fName Worksheets(Model).Activate End Sub 3)Private Sub task_Select3() Selection.AutoFilter Field:=3, Criteria1:=">1", Operator:=xlAnd Rows("3:10000").Select Range("B3").Activate Selection.Delete Shift:=xlUp Selection.AutoFilter Field:=3 ActiveWindow.LargeScroll Down:=-25 Range("B1").Select End Sub 4)Sub A_Main_task() '動作用メイン処理 Application.Run "backup_task" Application.Run "task_Loop" Application.Run "CommentMix" End Sub 5)Private Sub backup_task() 'バックアップ用コピー処理 Dim model As String, fName As String Model = ActiveSheet.Name fName = Model & "_copy" Worksheets(Model).Copy After:=Worksheets(Model) ActiveSheet.Name = fName Worksheets(Model).Activate End Sub -------------------------------------------- 1)でField:6に情報が入力されてないRecordを削除。 3)でField:3に「1」以外が入力されているRecordを削除。 ●1)の「Rows("3:5503").Select」でRecord「5000件」なら問題ないと思いましたが、   1)の結果は「4770件」でした。(5000件になると思ったのですが・・・) ・5000件以上のRecordを処理させようと思い、「Rows("3:5503").Select」の範囲を単純に増やしても1)の結果が減ってしまいます。 ◎Record数が「2700件」程度の情報は問題なく目的数の情報を抽出できました。 ●来週18日の月曜日中になんとか作成したい資料なのです。   お手数ですが宜しくお願いします。

  • オートフィルタからの選択部分のみからの抽出

    オートフィルタからある特定項目のみ表示して、その特定項目からのみデータを抽出したいのですがうまくいきません。 シートAAAAにある定常にオートフィルタをかけその定常部分のみから A1:B1の内容を抽出してセルBBBBにはり付けしたいという内容です。 Sheets("AAAA").Select With Worksheets("AAAA") .Range("B5").AutoFilter _ Field:=12, Criteria1:="定常" End With Sheets("BBBB").Select Sheets("AAAA").Range("B5:O15000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("B7"), Unique:=True Range("B7").Select Selection.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin 宜しくお願いします。

  • エクセルのVBAを教えて下さい。

    Private Sub OptionButton1_Click() Range("A15").Select Selection.Font.ColorIndex = 1 Range("B12").Select Selection.Font.ColorIndex = 1 Range("A18").Select Selection.Font.ColorIndex = 2 Range("B18").Select Selection.Font.ColorIndex = 2 Sheets("シート1").Image1.Visible = False Sheets("シート1").Image2.Visible = True End Sub 上記のようなプログラムがありますが、たとえば、以下をまとめてコンパクトに出来ますか? Range("A15").Select Selection.Font.ColorIndex = 1 Range("B12").Select Selection.Font.ColorIndex = 1 オートシェイプを利用して画像をエクセル内に作りました。 その画像を表示、非表示させたいのですが、どのようにすればよいでしょうか?よろしくお願いします。

  • VBAで関数式の値をセルに入力できるようにしたい。

    こんなマクロをマクロの記録で作ったのですが SUMIF関数の数式をセルに入力するのでなく 値だけを入力するしたいのですがどのように すればいいでしょうか? Sub Macro4() Columns("O:O").Select Selection.Insert Shift:=xlToRight Range("N3").Select Selection.AutoFill Destination:=Range("N3:O3"), Type:=xlFillDefault Range("N3:O3").Select Range("O5").Select ActiveCell.FormulaR1C1 = "=SUMIF(出荷貼付け!C1,RC1,出荷貼付け!C5)" ←ここのところを値だけをセルに入力したい。 Selection.AutoFill Destination:=Range("O5:O978") Range("O5:O978").Select Range("O4").Select End Sub

  • 条件にマッチする行を抽出するVBAを教えてください

    アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます excelで、添付画像のようなリスト管理表を作っています。 リストは600行近くになります。 やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。 D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。 触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だけのリストとなり、印刷するだけでいいようにしたいわけです。 本来ならオートフィルタですればいい話ですが、どうしてもD3という離れたセルの入力内容で抽出したいのです。 VBAでなく、D3のセル内容を使ってD8~のオートフィルタが行えるなら、それが一番理想です。 が、自分でやってみた限りはできませんでした。 フィルタオプションならどうかとやってみたところ、一回目は抽出できました。しかし、D3またはE3の条件を変更しても、リアルタイムで抽出結果が切り変わらない。 フィルタオプションの抽出結果を別のセルに出せばいいのですが、そうすると無駄な情報が残り、ただ印刷しただけでOK・・というわけにいきません。(印刷範囲を区切るとかでなく、シートの見栄えが必要な情報だけにならないと…扱う初心者が混乱します) 自分なりには、VBAにより、 D3・E3のセル内容が書き換わったらフィルタオプションの抽出結果をいったん同シートの別セルに出し、抽出結果部分だけを別のシートにカット&ペースト成形。そのシートを印刷させればよい。 という考えになりましたが、やってみたら、なぜか別のブックに同じものが形成され、抽出した結果だけ単独のデータにできません。 そもそももっと良いアイデアがあればそれをおしえていただきたい。 あるいは、VBAで目的達成できるように問題点をご指摘ください。 一応、プログラムを書いておきます ■添付画像のデータが入っているシート(『一覧』という名前のシート)内コード Private Sub Worksheet_Change(ByVal Target As Range) ' If Target.Column = 4 Then If Target.Row >= 3 And Target.Row <= 3 Then Call Filter Call copy End If End If End Sub ■サブルーチンFilter() 標準モジュールに記載 Sub Filter() ' Filter Macro 'フィルタオプションを使って同シート内「D1100」以降に抽出結果を出します ActiveWorkbook.Worksheets("一覧").Select '一覧表はD7~F1000。検索条件はD2~F3までの範囲に名前を付けたもの Range("一覧表").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "検索条件"), CopyToRange:=Range("D1100"), Unique:=False Range("A1").Select End Sub ■サブルーチンcopy() 標準モジュールに記載 Sub copy() ' ' copy Macro ' '抽出された内容(45行目~100行目まで)を別のシートにコピーします ActiveWorkbook.Worksheets("一覧").Select Rows("45:100").Select Selection.Cut ActiveWorkbook.Worksheets("抽出結果").Select Rows("4:4").Select Selection.Insert Shift:=xlDown Range("A1").Select End Sub

  • エクセルVBAで教えて下さい。

    A1のセルに [ 1- 5] 4.05398e-01 3.63385e-01 -2.22992e-01 9.89158e-03 -6.43695e-02 A2のセルに [ 6-10] -5.12224e-04 4.07480e-04 -2.73746e-04 -1.77853e-02 -2.13805e-03 A3のセルに [11-15] -6.88489e-03 -2.06765e-02 -9.44633e-03 6.97059e-03 -1.28400e-02 と、このような感じでA7セルまで同じ感じでスペースで空いた数値が入力されています。 A8のセルのみ [36-37] -6.39210e-03 -1.55806e-03 と入力されております。 まず行いたいのはスペースが空いてる部分で、それぞれの数値を各セルに分けたいです。 A1のセルに入力されている [ 1- 5] 4.05398e-01 3.63385e-01 -2.22992e-01 9.89158e-03 -6.43695e-02 ならば A1に[1-5] B1セルに4.05398e-01 C1セルに3.63385e-01 のように これをA1からA8のセルで行ったあと指定のセルを30行目に貼り付けます。 E1→A29 C2→B29 D2→C29 E2→D29 E3→E29 F3→F29 B4→G29 D5→H29 E5→I29 F5→J29 貼り付けのデータは増えていきます。つまり、30行目にデータが入ってる場合は そのデータが1行下の行に下がり、新たなデータが30行目に追加されます。 このようにして、データが最大で58行目まで追加される可能性があります。 最小であれば30行目、31行目の2つしかない場合あります。 この時、0の近似値を各列のセルから探し、当てはまるセルを赤く塗り潰すというのが 今回行いたいことです。 A列ならA30~A58までの中で0の近似値を探し、当てはまるセルを赤く塗り潰す。 ただ空白の場合は無視してもらいたいです。0の近似値だと空白が選択されてしまうので。 近似値探しの前までならマクロがありますのでご参照下さい。 Sub Macro4() ' ' Macro4 Macro ' ' Range("A1:A8").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(21, 1), Array(34, 1), Array(47, 1), _ Array(60, 1)), TrailingMinusNumbers:=True Range("A1").Select Range("E1").Select Selection.Copy Range("A29").Select ActiveSheet.Paste Range("C2:E2").Select Application.CutCopyMode = False Selection.Copy Range("B29").Select ActiveSheet.Paste Range("E3:F3").Select Application.CutCopyMode = False Selection.Copy Range("E29").Select ActiveSheet.Paste Range("B4").Select Application.CutCopyMode = False Selection.Copy Range("G29").Select ActiveSheet.Paste Range("D5:F5").Select Application.CutCopyMode = False Selection.Copy Range("H29").Select ActiveSheet.Paste Range("J7").Select Application.CutCopyMode = False Range("A29:K29").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A29:K29").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("A29").Select Range("A1:F8").Select Selection.ClearContents Range("A1").Select Range("K29").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormatLocal = "G/標準" End Sub わかりずらい質問ですみませんが、ご指導の程 お願い致します。

  • エクセル2007 VBAについて教えてください。

    顧客情報と販売履歴をソフトからCSVで書き出してシート1とシート2へ貼り付けしてそのデータをシート3へ抽出しているのですが、もっと良い方法があれば教えてください。 顧客情報と販売履歴がソフト上の関係で別々に書き出しされる為、シート1へ顧客情報のみを貼り付けしております。シート2に販売履歴を貼り付けしております。 そのデータを別シート A納品番号 B代引金額 C略称 D客先名 E郵便番号 F住所1 G住所2 H.TEL K納品番号(A列と同じコードです)L伝票No M管理番号 N客先情報 O商品コードP商品名Q数量 R納入単価 S納入金額 T客先コード変換 U商品名半角 へ転記するようにしております。 ここで抽出ボタン(マクロ起動)すると161行目から抽出するようにしております。 Private Sub CommandButton3_Click() Range("K161").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A161:A162"), CopyToRange:=Range("K161"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K167").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A167:A168"), CopyToRange:=Range("K167"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K173").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A173:A174"), CopyToRange:=Range("K173"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K179").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A179:A180"), CopyToRange:=Range("K179"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K185").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A185:A186"), CopyToRange:=Range("K185"), Unique:=False Range("K191").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A191:A192"), CopyToRange:=Range("K191"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K197").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A197:A198"), CopyToRange:=Range("K197"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K203").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A203:A204"), CopyToRange:=Range("K203"), Unique:=False Range("K210").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A210:A211"), CopyToRange:=Range("K210"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K216").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A216:A217"), CopyToRange:=Range("K216"), Unique:=False Range("K222").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A222:A223"), CopyToRange:=Range("K222"), Unique:=False そしてこのデータを転送用と言うシート A3納品番号 B3商品名1 C3商品名2 D3商品名3 E3氏名 F3郵便番号 G3住所1 H3住所2 I3住所3 J3名前2 K3電話番号 R3代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか? 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。

  • excel2007VBA 二つの動作の繰り返し処理

    excel2007でマクロを勉強し始めたばかりです。VBAの繰り返し処理をしたいのですが、以下のようなマクロの請求書個別発行を一括発行にしたいと考えています。繰り返し開始から、終了までを、数値がなくなるまで繰り返したい場合、どのようになるでしょうか。よろしくお願いします。 Sub 請求書個別発行() ' ' 請求書個別発行 Macro ' ' Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False    Sheets("得意先").Select Range("C3:O90").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "得意先!Criteria"), CopyToRange:=Range("R6:AD325"), Unique:=False 繰り返し開始 Sheets("売上一覧表").Select Range("T4").Select   (T4からT5,T6,T7、、、と降順に値がなくなるまで選択される。) Selection.Copy        (T4=Y4)  Range("Y4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("請求書").Select Range("B16").Select  (B16から、B17、B18,,,と降順に値がなくなるまで選択される。)   Selection.Copy       (B16=I6) Range("I6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("請求書").Select Application.Dialogs(xlDialogPrint).Show 繰り返し終了 End Sub 以下は自分なりに考えたVBAですが、エラーになります。 Sub 請求書集計発行() ' ' 請求書発行 Macro ' ' Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("得意先").Select Range("C3:O90").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "得意先!Criteria"), CopyToRange:=Range("R6:AD325"), Unique:=False Dim wst1 As Worksheet Dim wst2 As Worksheet Set wst1 = ThisWorkbook.Worksheets("売上一覧表") Set wst2 = ThisWorkbook.Worksheets("請求書") Dim i As Long Dim j As Long For i = 4 To 100 For j = 16 To 100 If wst1.Range("T" & i) <> "" And Not IsNull(wst1.Range("T" & i)) Then If wst2.Range("B" & j) <> "" And Not IsNull(wst2.Range("B" & j)) Then myrow = wst1.Cells(Rows.Count, 1).End(xlUp).Row + 1 myrow = wst2.Cells(Rows.Count, 1).End(xlUp).Row + 1 wst1.Range("T" & myrow) = wst1.Range("Y4") Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("請求書").Select wst2.Range("B" & myrow) = wst2.Range("I6") Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("請求書").Select Application.Dialogs(xlDialogPrint).Show End If Next i Next j End Sub