- ベストアンサー
EXELで重複しない抽出をするVBAについて
jcctairaの回答
- jcctaira
- ベストアンサー率58% (119/204)
kyon0512さん おつかれさまです。 同じことを繰り返しているような感じです。 最終的にはどうしたいのでしょうか？ 前回は A品（神）、A品（東）…にしたのではなかったのですか？ プログラムのコードで使った変数と表のデータは全く別のものですよ。 よって、kyon0512さんはプログラムは考えないで、どういう表の内容をどうしたいのですか？ ・以下のデータのように、（ ）は使わないでA品_神、A品_東、B品_大で区別するのですか？ ・社内、メーカーとか追加して表示したいのですか？ ・その場合、何行目に表示したいのですか？ ・次の説明が理解できません。 1行目と２行目は同じと思うですが？ > A品_神 = 7 A品_東 = 27 B品_大 = 37を指定でなく > 上から順にした方がいいみたいなのでA品_神 = 7 A品_東= 27 B品_大 = 37 > jcctairaさんがVBAのHPも作られたら分かりやすいのを作られると思いますが。 VBAを分かりやすく説明しようとすると、分厚い参考書のようになってしまう量です。 そう簡単にはできないですね。 ちょっと言わさせて頂くと、 私はSEをやっていましたが、仕様がコロコロ変わるユーザは嫌われます。 最初から何を（元データ）をどうしたい…をはっきり決めてから、システム化要望することです。 kyon0512さんも分かるかと思いますが、プログラムを作って・テストをして完成したと思ったら また安易に修正要望があって、最後だと思ってプログラムを完成したら、また修正要望…。 なるべく最終の仕様（プログラム作成要望）を確定するように心掛けてくださいね。 A品_神 = 7 、 A品_東 = 27 、 B品_大 = 37 、その他は ＝ ？？？ a社 A品_神 b社 A品_神 d社 A品_神 g社 A品_神 ab社 A品_東 e社 A品_東 da社 A品_東 bd社 B品_大 h社 B品_大 ig社 B品_大 as社 社内 bl社 メーカー ccc社 メーカー aj社 学生 br社 その他
関連する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
- ベストアンサー
- オフィス系ソフト
- エクセルでの自動抽出がうまくいきません
エクセル２０００で自動抽出機能を使用しましたが最初の行の項目だけ重複して抽出されます。直す方法はありませんか？自動抽出の方法はデータセルを指定してデータ→フィルタ→フィルタオプションの設定→選択範囲内をデータのセルに指定、指定した範囲を抽出先のセル指定、重複するレコードは無視するにチェックをいれｏｋです。なお上記のマクロは次のようになっています。Sub 商品名の集計() ' ' 商品名の集計 Macro ' マクロ記録日 : 2002/6/30 ユーザー名 : ｋｙ ' ' 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 宜しくお願いします。
- ベストアンサー
- Visual Basic
- エクセルのＶＢＡを教えて下さい。
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～F３までの範囲に名前を付けたもの 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行目に追加されます。 このようにして、データが最大で５８行目まで追加される可能性があります。 最小であれば30行目、31行目の２つしかない場合あります。 この時、０の近似値を各列のセルから探し、当てはまるセルを赤く塗り潰すというのが 今回行いたいことです。 A列ならA30～A58までの中で０の近似値を探し、当てはまるセルを赤く塗り潰す。 ただ空白の場合は無視してもらいたいです。０の近似値だと空白が選択されてしまうので。 近似値探しの前までならマクロがありますのでご参照下さい。 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 わかりずらい質問ですみませんが、ご指導の程 お願い致します。
- ベストアンサー
- Excel（エクセル）
- エクセル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代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか？ 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。
- ベストアンサー
- Visual Basic
- 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
- ベストアンサー
- オフィス系ソフト
補足
おはようございます。 おっしゃるとおり、大変大変申し訳ありません。 ・以下のデータのように、（ ）は使わないでA品_神、A品_東、B品_大で区別するのですか？ 誤記です、最初のA品（神）、A品（東）…の表示のままです。 ・社内、メーカーとか追加して表示したいのですか？ 最初本支店とかの例を出しましたが書いて頂いたモジュで本支店が残っていたのでそれはクリアーにし て頂いて、社内とかメーカー・・に変更したいです。 ・その場合、何行目に表示したいのですか？ A品_神、A品_東、B品_大、社内、メーカー、学生、その他（以外のその他ということで） 上記の７区分での上から順番に抽出です。 1行目と２行目は同じと思うですが？ > A品_神 = 7 A品_東 = 27 B品_大 = 37を指定でなく > 上から順にした方がいいみたいなのでA品_神 = 7 A品_東= 27 B品_大 = 37 すみません、誤記です。A品（神） = 7からから始まり、その次の行から行指定無しで続けてA品（東）、B品（大）、で社内=45行目から、順番に行指定無しで、メーカー、学生、その他 としたいです。 ころころ変わり本当に申し訳ありません。自分でも作りながら同じページに抽出するとなると 行幅も元のシートに合わせるとなると見にくい表になってしまし、どうしようかと色々と迷いながらやっているので そうなってしまっています。 本当に済みません。 宜しくお願いします。