advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 103 for フォーマット 自動 印刷 (0.009 sec.)
フォーマット (1423), 自動 (14517), 印刷 (5709)
[[20130403114539]]
#score: 8137
@digest: 015f48fcbe8815f603a2a6a721a91632
@id: 61974
@mdate: 2013-05-29T15:16:49Z
@size: 155628
@type: text/plain
#keywords: 版. (263424), ニサ (250880), 用最 (243686), サニ (193279), 庫月 (190365), 終版 (155172), 外来 (154900), 物品 (148439), 出庫 (85013), タ整 (80293), 用量 (77715), 部署 (65080), 計用 (39720), scrollcolumn (38559), 応表 (32568), 署名 (29262), 庫数 (27157), 様式 (25820), formular1c1 (22894), characters (22728), selection (17739), 整理 (17732), activecell (16458), activewindow (16409), 最終 (16060), select (16003), 見出 (15490), 商品 (13865), 品名 (13801), デー (13677), 終行 (12871), sheets (12523)
『エクセルのオートフィルタをかけた可視セルを参照する方法について』(machi)
エクセル2007で、オートフィルタをかけたセルから必要なセルだけを、 他のシート(もしくは同じシート)で参照する方法について教えてください。 フィルタオプションを使用して、範囲指定など行って他のセルに参照させる 方法を実施したのですが、この場合、もとのデータを変更しても参照先のデータが変更さ れないため、目的にかなわないことがわかりました。 通常のセルの参照のように、元のデータを変えれば参照セルの データも変わるようなタイプでの可視セル参照方法はどのようにすればできるのでしょう か。 部署でフィルタをかけて「あ」をのみを選択。「あ」部署の、 ある物品の毎月の使用量を月別に表示し、その可視セルを他のシートに参照させたいとい う感じです。 すべての部署別に一覧にしたいため、いちいちコピーして 可視セル貼付けですと、かなり手間がかかってしまうため、方法を検討しているところです。 A B C D ------------------------------- 1 月日 部署 物品 使用量 ------------------------------- 2 4月 あ ○ 2000 ------------------------------- 3 5月 い ○ 2500 ------------------------------- 4 5月 あ ○ 6800 ------------------------------- 5 7月 え ○ 500 ------------------------------- 6 6月 あ ○ 4800 ------------------------------- よろしくお願いいたします。OSはXPです。(エクセル2013でWindows8もありますので、どちらかでお願いいたします。) ---- 参照させたいというのが具体的にどうしたいのかが判らないので目的に合うかは判らず。 例えばE列を作業列として E2セルに =IF(D2<>"",SUBTOTAL(9,D2),0) と入力してE6セルまでコピー。 これでE列は非表示の行は0、表示されている行はD列と同じ値が表示される。 あとはSUMIFSなどを使って抜き出せないか? (ねむねむ) ---- オートフィルタ使わないで、最初っからフィルタオプション使うんじゃダメかな? http://www.eurus.dti.ne.jp/‾yoneyama/Excel2007/excel2007-filter2.html Excel2007(エクセル2007)基本講座:データの抽出(フィルタ オプションの設定) (1111) ---- ねむねむさま ありがとうございます。教えていただいた方法を試してみました。 これを、別のシートに表示させる方法について教えていただいても良いでしょうか。 10種類の物品、50部署の1年分のデータが、各物品別に別々のシートに集計されており、 これを、今度は部署別に各物品使用量一覧にする必要がある状態です。(下記のような感じに) A B C D ------------------------------- 1 月日 部署 物品 使用量 ------------------------------- 2 4月 あ ○ 2000 ------------------------------- 3 4月 あ ▽ 2500 ------------------------------- 4 4月 あ ◆ 6800 ------------------------------- 5 4月 あ ★ 500 ------------------------------- 6 4月 あ ○ 4800 ------------------------------- 各物品別にあるシート上で、部署「あ」をオートフィルタで選んだ時は、別シートに部署「あ」の物品使用量一覧が表示され、 部署「い」を選んだ時は、同じ別シートに部署「い」の物品使用量一覧が表示される、といった感じになるとうれしいのです。 エクセルは初心者で、どの言葉を使用するとうまく伝わるのかわからず、お手数をおかけしますが、よろしくお願いいたします。(machi) ---- 物品ごとにシートが分かれているデータがある。 その中から、指定した部署のデータだけを集めて 一覧にしたい。 って事ですよね? 現在の最大の問題点は >物品ごとにシートが分かれている って事だと思います。 シートが分かれているから >部署でフィルタをかけて「あ」をのみを選択。 の作業も、シート数だけしないといけないですよね。 データ量等、色々な条件もあるとは思いますが 入力は一つのシートにずらずらっと 行う。 今回はこれ以上増えないなら、とにかく一つのシートにデータを集める。 もう一つシートを作って 特定の物品のデータが見たい場合は、その物品だけを抜き出して表示。 特定の部署のデータが見たい場合は、その部署だけを抜き出して表示。 と言った構成にすると、作業も少しは簡単になると思います。 データが一つの表にまとまっていれば フィルタで絞り込むだけで、目的の表になりそうですが・・・ 構成の変更が出来ない場合、同じ作業を繰り返すのは面倒なので マクロを使って、エクセルにやらせるのが得策に思えます。 マクロ(VBA)が使える環境であれば、もっと具体的に状況の説明をしてもらうと良いと思います。 たとえば、 ・各物品別のデータが入っているシートと、その他のシートとの見分け方 ・物品使用量一覧を表示したいシート名 等。 (HANA) ---- HANAさま アドバイスありがとうございます。 そして、私の拙い説明を理解していただき、本当にありがとうございます! 構成の変更に関しては、外部業者が出してくるデータなので無理だと言われました。 提出されるデータは、1か月ごとに1つのシートに1商品の出庫量等が全部署分入っています。 また、各商品によって表示されている項目(出庫量やメーカー名、出庫日時など)がバラバラなため、1つのシートにまとめるにも、項目を合わせるだけでかなり難渋する状態です) ちなみにデータは日々増殖中です。 マクロは使用しても良いそうです。 ですが、私は「マクロの記録」というもので数回使用したことがある程度で、あの難しい言語?は自力ではまったく組めない状態です。 >マクロ(VBA)が使える環境であれば、もっと具体的に状況の説明をしてもらうと良いと思います。 たとえば、 ・各物品別のデータが入っているシートと、その他のシートとの見分け方 →こちらは、シートに各商品名が入っている状態です。 ・物品使用量一覧を表示したいシート名 →こちらは、○○部署という形で全部署分作成する予定です。 (machi) ---- >1か月ごとに1つのシートに1商品の出庫量等が全部署分入っています。 完成させるデータも、1か月ごとで良いのでしょうか? 元データは >10種類の物品、50部署の1年分のデータが って話だったと思いますが。。。 >各商品によって表示されている項目(出庫量やメーカー名、出庫日時など)がバラバラなため、〜〜 そのうち、必要な項目は決まっているのですよね? 項目名等は統一されていてピックアップすれば良いのでしょうか? 項目数は、いくつくらいあるのでしょう? >マクロは使用しても良いそうです。〜〜 それは良かったです。 誰でも初めての時はあります。 VBAは多くの一般の人が使っているものですから、意気込み次第だと思っています。 コードを作りにあたり、machiさんに説明してもらわないといけないことがあります。 目の前にエクセルファイルが無い状態で、その仕事の引き継ぎをする場合を想定して下さい。 どの様に説明しますか? 全てのデータシートでフォーマットが同じで、結果も同じフォーマットで良いのなら話は簡単ですが (当初のご説明に+で「どのシートが、各物品別のデータが入っているシートなのか 等」 の説明があれば滞りなく作業が出来ると思います。) 実際はそうでは無い様ですので。。。 特徴的ないくつかのシートを例に挙げて説明してもらえますか? ・必要な項目(物品使用量一覧に表示が必要な項目) ・各物品別の シート名、項目とその並び 等 (HANA) ---- HANAさま ・ 完成させるデータも、1か月ごとで良いのでしょうか? →はい。1か月ごとに必要になります。1年分が同じシートで良いのですが、4月から順番に表になっている必要があります。 ・必要な項目(物品使用量一覧に表示が必要な項目) @商品名、A出庫月、B部署名、C出庫量、D実働使用量(これは、1本が500mlの洗剤が3個出庫だった場合、1500mlとなります)です。 外部業者が提出するデータは、項目名が統一されていないため、該当するものを選んでいく必要があります。 また、提出されるデータの項目数は業者によって4-10個と幅があります。 ・各物品別のシート名、項目とその並び 最も煩雑なデータを提出する業者のものを例にあげます。 物品別シート名:「サニサーラ250ml」 項目名:薬品コード、薬品名称、規格、包装数、出庫先、出庫数、出庫返品数、実出庫数、実出庫金額です。各列に1項目ではなく、行を変えて違う項目を入力してあります。↓ A B C D E ------------------------------- 1 薬品コード 薬品名称 規格 包装数 ------------------------------- 2 サニサ40 サニサーラ 250ml 1 ------------------------------- 3 部署 出庫数 出庫返品数 出庫実働数… ------------------------------- 4 あ 46 1 45 ------------------------------- また、1月で出庫が0だった部署は入力されないため、部署名も毎月並びが変わってしまいます。 部署名は何かを参照しているのか、=RIGHT(A6,LEN(A6)-FIND("/",A6))という数式?が入っており、普通にコピーすると他のセルには部署名がコピーされませんでした。 >10種類の物品、50部署の1年分のデータ〜 各物品別に1月ごとに集計されているデータを、1年分にまとめたのは私です。 各物品別ならば、項目名数に変化がないためコピーしやすかったものですから。 10回フィルターをかけなおすのは面倒ですが、もうとにかくこれでフィルターをかけて、別のシートで参照させるくらいしか、手を思いつきませんで…。 データ量は、1つの物品で1000桁まで行数がいく状態でした。 なので、10個ですと10000桁になるんでしょうか。 今あるデータだけでしたら、HANAさまに教えていただいたとおり、不要な項目を削除して、すべて同じシートに入れてしまうのが一番手っ取り早いかもしれません。 ただ、毎月増殖していくのでそれらをどうすれば良いのか不安です。 ・どの様に説明しますか? これは難しいです〜。 4つの業者から、1年間に納入された物品のデータが提出されています。 提出されたデータ内容は、業者ごとに報告項目が違っていますが、これから作成するデータに必要なデータは揃っています。 また、元データは、納入している物品別にシートを分けて、1月分ずつ全部署分のデータが入った状態で作成されています。 このデータを、各部署別に分け、毎月の物品の実働使用量を出して提出しなければなりません。 こんな感じでしょうか。我ながらわかりにくいです。申し訳ありません。よろしくお願いいたします。 ---- >各列に1項目ではなく、行を変えて違う項目を入力してあります。↓ それは厄介ですね。 全てそうなんでしょうか? それとも、物品によって その様になっているシートもあるし 1行で完結しているシートもある のでしょうか? >部署名は何かを参照しているのか、=RIGHT(A6,LEN(A6)-FIND("/",A6))という数式?が入っており この時のA6セルには、どのようなものが入力されていますか? 式自体は A6セルに入力されている文字内で「/」の位置を探しそれより右側の文字を取り出す と言った事をやっています。 案外その他の情報もA6セルに入っていたりしませんか? ご提示のサンプルは、1件目のデータだと思います。 2件目からも同様に、タイトル-1,データ-1,タイトル-2,データ-2 の様に 4行単位で並んでいるのでしょうか? まず、エクセルで扱いやすくするために、データを整理するのが良いと思います。 これは、基本部分をマクロの記録で出来ると思います。 まずはご提示の表で、データ量が2件の場合で記録を取ります。 ご提示の例(A:Eの範囲が使ってある表)であれば、 1.A3:D8を選択 2.コピー 3.F1セルから貼り付ける。 4.J1:J8を選択(表の終わりの次の列の範囲を選択です。) 5.=MOD(ROW(A3),4) と入力して、Ctrl + Enter 6.オートフィルタを設定 7.A2:J8選択 8.J列のオートフィルタで「0」以外の項目を表示 9.右クリック→行の削除(D) 10.オートフィルタを解除 11.結果を表示する項目順に列を移動 (列を選択して、Shiftを押しながらドラッグすると移動できます。 列を切り取り、目的の場所に挿入貼り付け でもOKです。) 項目はそれぞれで違うと思いますが >@商品名、A出庫月、B部署名、C出庫量、D実働使用量 の順ですかね? 6列目以降は、今回使うわけではないので 並びは問いません。 ただ、出庫月・出庫量・実働使用量は、元データ内に直接の値は無いのでしょうか? もしかしたら、7番の手順と同じ様に数式を埋め込む必要が あるのかもしれないですね? 12.数式を追加したJ列を削除 元データを整えるコードの基本部分は完成します。 後は、完成したコードを開いて少し修正していきます。 まずは、記録を取って こちらにコードを載せてみてください。 このコードの目的は『元データを整える』です。 パターン分用意しておいて、新しいデータが届いたら そのシートをアクティブにして、対応したマクロを実行して使用する目論見です。 マクロは毎月使うので、マクロ用のブックを一つ用意してそれに入れておくのが良いと思います。 後で修正しますので、 マクロ用のブックと、データが有るブック(コピーしたものを使用して下さい)を開いておいて マクロ用のブックでマクロの記録を開始し データが有るブックをアクティブにしてから 1〜12の作業を行って下さい。 「コードを開いて修正する」と書きましたが、例えば >1.A3:D8を選択 の部分なんかは、記録にとると Range("A3:D8").Select と記録されますが、実際はE列のデータが有る最終行までの範囲を選択する必要が有ります。 A1:A8に値が入っている状態で A20セルをアクティブにして Ctrl + ↑ を押してみてください。 すると、アクティブセルは A8セルに移動します。 この動作(Ctrl + ↑)を記録にとると Selection.End(xlUp).Select と言うコードが記録されます。 先の記録とは別に、これも確認してみてください。 1〜12の記録が出来たらコードを載せてもらえると良いのですが。 その際、先のサンプルデータが説明の為に小さくしたものだったら 「説明の為に××にした所は、実際は●●です」と注釈をお願いします。 また、4行セットでない場合は5番で入れる数式の変更が必要です。 >=MOD(ROW(A3),4) 「A3」の所は、セット数-1 、「4」の所は、セット数 に変更して下さい。 たとえば、6行セットだった場合 =MOD(ROW(A5),6) の様に成ります。 それから、セルの結合等が有る場合はなるべく早く解除しておくのが良いと思います。 1番の前に、「A1:E8を選択・セルの結合を解除」の作業をして下さい。 あと、部署名の所に数式が入っているのも 記録時に問題になるかもしれないですね。 この行も一行に並ぶように貼り付け作業をして下さい。 1〜3の手順を繰り返して貰う事になると思います。 (HANA) ---- 良く考えたら、数式が入っている所は 1行目を参照しているのでない場合 他の行は削除してしまうので、エラーになってしまいますね。 1番の前に、「A1:E8を選択・セルの結合を解除・コピー・値貼付」 の手順を入れて下さい。 ‾‾‾‾‾‾‾‾‾‾‾‾‾‾ (HANA) ---- HANAさま 返信おそくなり申し訳ありませんでした。 手順1-12を取り敢えずやってみた結果です。↓ Sub Macro5() ' ' Macro5 Macro ' ' Range("A4:P21").Select Selection.Copy Range("R4").Select ActiveSheet.Paste ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.SmallScroll ToRight:=3 Range("AH3:AH21").Select Application.CutCopyMode = False Selection.FormulaR1C1 = "=MOD(ROW(R[12]C[-33]),16)" Range("AH25").Select ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Rows("5:5").Select Selection.AutoFilter Range("A6:AH21").Select ActiveSheet.Range("$A$5:$AH$20").AutoFilter Field:=34, Criteria1:=Array( _ "10", "11", "12", "13", "14", "15", "2", "3", "4", "5", "6", "7", "8", "9"), Operator:= _ xlFilterValues Columns("X:X").Select Selection.Delete Shift:=xlToLeft Columns("W:W").Select Selection.Delete Shift:=xlToLeft Columns("T:V").Select Selection.Delete Shift:=xlToLeft Columns("AA:AA").Select Selection.Delete Shift:=xlToLeft Columns("Z:AA").Select Selection.Delete Shift:=xlToLeft Columns("Z:Z").Select Selection.Delete Shift:=xlToLeft End Sub 実際の元データは、例を挙げたエクセルの表どころではなく、 行と列がまったくランダムに組まれてしまっている状態です。 (出庫数という項目名のしたに実際の数値があるのではなく、なぜか2列あけて次の列に入っているなど。) A BC D E ---------------------------------------- 出庫数 ---------------------------------------- 7←これが出庫数 ---------------------------------------- とか、 A BC D E F GH ------------------------------------------------ 薬品名称 規格 ------------------------------------------------ サニサーラ 500ml ------------------------------------------------とか…。 教えていただいた方法を、これにどのように当てはめればいいのかわからず、 マクロを実施しても必要なデータにすることができず(T-T)。すみませぬ。 項目数が5に対して、使用している列が全部で16あります。 たぶん、印刷した時の見栄えがいいのだと思いますが、列の幅も大小様々です。 セルの統合をしている部分はありません。 そして一行(1列)で完結している項目もありません。 出庫年月日は、表の1番上に記載されていますが、病棟別には入力されていません。 いらない列をすべて削除し、必要な項目名を改めて入力する方法で、 各商品別に項目をすべて合わせて1年分データをまとめた次第です。↓ Sub Macro6() ' ' Macro6 Macro ' ' Rows("1:6").Select Selection.Delete Shift:=xlUp Range("H1").Select Selection.Cut Destination:=Range("I1") Range("B1").Select ActiveCell.FormulaR1C1 = "部署" With ActiveCell.Characters(Start:=1, Length:=2).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 2).PhoneticCharacters = "ブショ" Range("A:A,C:H,J:P").Select Range("J1").Activate Selection.Delete Shift:=xlToLeft Range("C1").Select ActiveCell.FormulaR1C1 = "使用量" With ActiveCell.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 3).PhoneticCharacters = "シヨウリョウ" Range("D1").Select ActiveCell.FormulaR1C1 = "商品名" With ActiveCell.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 3).PhoneticCharacters = "ショウヒンメイ" Range("D2").Select ActiveCell.FormulaR1C1 = "サニサーラ" With ActiveCell.Characters(Start:=1, Length:=5).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With Range("C2").Select ActiveCell.FormulaR1C1 = "=RC[-1]*250" Range("C2").Select Selection.AutoFill Destination:=Range("C2:C14"), Type:=xlFillDefault Range("C2:C14").Select Range("D2").Select Selection.AutoFill Destination:=Range("D2:D14"), Type:=xlFillDefault Range("D2:D14").Select Range("E19").Select End Sub こんな感じのことをやって、それをマクロ登録して元データで実行しデータ整理をしました。 >A1:A8に値が入っている状態で A20セルをアクティブにして Ctrl + ↑ →これは、やってみましたがアクティブセルが、3つほど上にあがりましたが他はなにも起きませんでした。 データの整理は、こんな感じならば毎月やれそうな感じがします。 次は、この商品別のデータを、部署別に一覧表にする方法でしょうか? よろしくお願いいたします。 ---- 今作ってもらおうとしているマクロは 現在印刷レイアウトの関係で [A] [B] [C] [D] 1 【見出し1】 2 データ1-1 3 【見出し2】 【見出し3】 4 データ1-2 データ1-3 5 【見出し1】 6 データ2-1 7 【見出し2】 【見出し3】 8 データ2-2 データ2-3 の様になっているものを [A] [B] [C] 1 見出し-1 見出し-2 見出し-3 2 データ1-1 データ1-2 データ1-3 3 データ2-1 データ2-2 データ2-3 4 データ3-1 データ3-2 データ3-3 の様に配置を整えるのが目的です。 この作業は送られてくるシートのレイアウトは同じだと思うので 毎回同じ作業を繰り返すことになると思います。 もしも「同じ商品でもレイアウトは毎回少しずつ違う」と言う場合は 記録マクロでの対応は困難ですので、別の方法を考えた方がよさそうです。 ちなみに、商品毎にシートが分かれているという事ですが それぞれのレイアウトは同じなのでしょうか?違うのでしょうか? >必要な項目名を改めて入力する方法 で、データを整理してもらうと良いと思います。 ただ、現在いらない情報でも 今後必要になるかもしれませんので それは削除するのではなく、列の最後に固めておいてもらうと良いと思います。 (A:Dが必要な列で、E列以降は今回不要な列・・・って感じで) Macro6でC2セルに入れた式は、日付を参照するものでしょうか? >教えていただいた方法を、これにどのように当てはめればいいのかわからず、 実際にどの様なものを相手にしているのかこちらからは見えないので 「○○な感じで〜」としか書きにくい状況です。 ・項目名のすぐ下にデータがあるわけではない と言う事は分かりました。 行方向のもう少し詳細なレイアウトを教えて下さい。 一つのシートに、何件かのデータが入っているのですよね? 1件目が何行目から始まっていて 2件目は何行目から始まっているのでしょう? もう一度↑のサンプルを例にして、イメージを書いてみます。 元データ [A] [B] [C] [D] 1 【見出し1】 2 データ1-1 3 【見出し2】 【見出し3】 4 データ1-2 データ1-3 5 【見出し1】 6 データ2-1 7 【見出し2】 【見出し3】 8 データ2-2 データ2-3 A3:D8をコピーして、E1から張り付け (この例ではA3:A4にデータが無いので、B3からコピーでも良いのですが。。。) [A] [B] [C] [D] [E] [F] [G] [H] 1 【見出し1】 【見出し2】 【見出し3】 ★2 データ1-1 データ1-2 データ1-3 3 【見出し2】 【見出し3】 【見出し1】 4 データ1-2 データ1-3 データ2-1 5 【見出し1】 【見出し2】 【見出し3】 ★6 データ2-1 データ2-2 データ2-3 7 【見出し2】 【見出し3】 8 データ2-2 データ2-3 すると、2行目と6行目に 複数行に分かれていたデータが1行になった行が現れます。 そこで、1行目の見出しを整えます。(必要な所に必要な見出しを入力) [A] [B] [C] [D] [E] [F] [G] [H] ★1 【見出し1】 【見出し1】 【見出し2】 【見出し3】 【見出し3】 ★2 データ1-1 データ1-2 データ1-3 3 【見出し2】 【見出し3】 【見出し1】 4 データ1-2 データ1-3 データ2-1 5 【見出し1】 【見出し2】 【見出し3】 ★6 データ2-1 データ2-2 データ2-3 7 【見出し2】 【見出し3】 8 データ2-2 データ2-3 A,E列はデータが無い列で、B列のデータはF列に。D列のデータはH列にコピー済。G列のデータはC列にあるので A,B,D,E,G列は削除します。 [A] [B] [C] [D] [E] [F] [G] [H] ★1 【見出し1】 【見出し2】 【見出し3】 ★2 データ1-1 データ1-2 データ1-3 3 【見出し3】 4 5 【見出し2】 ★6 データ2-1 データ2-2 データ2-3 7 【見出し3】 8 D1:D8に数式をいれて、オートフィルタで絞り込んで削除すると、1,2,6行目だけが残って [A] [B] [C] [D] [E] [F] [G] [H] 1 【見出し1】 【見出し2】 【見出し3】 2 データ1-1 データ1-2 データ1-3 3 データ2-1 データ2-2 データ2-3 4 5 6 7 8 になります。 >いらない列をすべて削除し、必要な項目名を改めて入力する方法で、 >各商品別に項目をすべて合わせて1年分データをまとめた次第です。↓ って事は、ここまで(のマクロ)は出来たって事ですか? ちなみに、↑を記録にとると Sub Macro1() ' ' Macro1 Macro ' ' Range("A3:D8").Select Selection.Copy Range("E1").Select ActiveSheet.Paste Application.Left = 340 Application.Top = 109.75 Range("C1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "【見出し1】" ActiveCell.Characters(2, 2).PhoneticCharacters = "ミダ" Range("H1").Select ActiveCell.FormulaR1C1 = "【見出し3】" ActiveCell.Characters(2, 2).PhoneticCharacters = "ミダ" Range("A:B,D:E,G:G").Select Range("G1").Activate Selection.Delete Shift:=xlToLeft Range("D1:D8").Select Selection.FormulaR1C1 = "=MOD(ROW(R[2]C[-3]),4)" Selection.AutoFilter Rows("2:8").Select ActiveSheet.Range("$D$1:$D$8").AutoFilter Field:=1, Criteria1:=Array("1", _ "2", "3"), Operator:=xlFilterValues Selection.Delete Shift:=xlUp Selection.AutoFilter Columns("D:D").Select Selection.Delete Shift:=xlToLeft End Sub こんな感じになります。 同じデータをつくって、上記コードを張り付けて結果を確認してみて下さい。 >>A1:A8に値が入っている状態で A20セルをアクティブにして Ctrl + ↑ >→これは、やってみましたがアクティブセルが、3つほど上にあがりましたが他はなにも起きませんでした。 3つほど上ののセルにデータが入っていましたよね? Ctrl + ↑は、データがある最後のセルに移動出来ます。 (この表現では、少し語弊があるのですが。。。) 上のサンプルでは、B,D列が一番したまでデータが入っている列になります。 たとえば、B列の一番下のセルをアクティブにして、Ctrl + ↑ をすると アクティブセルは B8セルに移動します。 もしも、データ件数が3件あって、B13セルまで入力があったとすると B列の一番下のセルをアクティブにして、Ctrl + ↑ をすると アクティブセルは B13セルに移動します。 Macro1で記録されているセル番地の内8行目を表す「8」と言う部分は 13行目まで入力があった場合「13」になってもらいたいし 37行目まで入力があったら「37」になってもらいたい部分です。 毎回数字を書き換えるのは大変なので、 マクロ内で Ctrl + ↑で、最終行を取得して コードに組み込もう と言う野望を抱きましょう。 Dim 最終行 As Long 最終行 = Range("B" & Rows.Count).End(xlUp).Row これで、「最終行」と言う変数に、B列の入力がある最後の行数が入ります。 これも踏まえてMacro1をもうすこし整理すると Sub Macro2() ' ' Macro2 Macro ' Dim 最終行 As Long 最終行 = Range("B" & Rows.Count).End(xlUp).Row Range("A3:D" & 最終行).Copy Range("E1").Select ActiveSheet.Paste Range("C1").FormulaR1C1 = "【見出し1】" Range("H1").FormulaR1C1 = "【見出し3】" Range("A:B,D:E,G:G").Delete Shift:=xlToLeft Range("D1:D" & 最終行).Select Selection.FormulaR1C1 = "=MOD(ROW(R[2]C[-3]),4)" Selection.AutoFilter Rows("2:" & 最終行).Select ActiveSheet.Range("$D$1:$D$" & 最終行).AutoFilter Field:=1, Criteria1:=Array("1", _ "2", "3"), Operator:=xlFilterValues Selection.Delete Shift:=xlUp Selection.AutoFilter Columns("D:D").Select Selection.Delete Shift:=xlToLeft End Sub になります。 件数を増やしたり減らしたりしても、目的の結果が得られることを確認して下さい。 たぶん「なぜその操作をするのか」がわかれば応用が出来ると思うので そのあたりも想像してみてもらえると良いと思います。 最終的には、1行目に見出しがあって 以降に、1件1行でデータがある表 が完成出来るなら、途中経過はどのようになっていても関係ないので。 マクロ実行のひと手間でデータ整理が済めば 手間も少なくて済むと思います。 もちろん「ここは手作業でしても苦にならないから良いよ」って事なら 次へ進みたいと思います。 コードを作りますのでデータ整理後の見出しの配列と ブック内でのシートの順番を教えて下さい。 (HANA) ---- HANAさま HANAさまに頂いたMacro2を実行すると、なぜか8行のみになってしまいます。(実際には30行前後はあるのですが) Dim 最終行 As Long 最終行 = Range("B" & Rows.Count).End(xlUp).Row の部分は、Bの列の最終行までカウントしてね、とういう意味でしょうか? Bには、部署名が入っていますので、確かにB列を最終行までカウントしてもらえば、全部出力されるはずなのですが、どう対処すれば良いのかわからずすみません。 ちょっと手直ししましたが、下記のような感じのことをすると欲しい表になります。 Sub データ整理() ' ' データ整理 Macro ' ' Columns("A:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("F6").Select →ここに商品名が入力されています Selection.Copy Range("A8").Select ActiveSheet.Paste Range("E4").Select →ここに出庫月が入力されています Application.CutCopyMode = False Selection.Copy Range("B8").Select ActiveSheet.Paste Rows("1:6").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp Range("C:C,E:J,L:R").Select Range("L1").Activate Selection.Delete Shift:=xlToLeft Range("A1").Select ActiveCell.FormulaR1C1 = "商品名" With ActiveCell.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 3).PhoneticCharacters = "ショウヒンメイ" Range("B1").Select ActiveCell.FormulaR1C1 = "出庫月" With ActiveCell.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 2).PhoneticCharacters = "シュッコ" ActiveCell.Characters(3, 1).PhoneticCharacters = "ツキ" Range("C1").Select ActiveCell.FormulaR1C1 = "部署" With ActiveCell.Characters(Start:=1, Length:=2).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 2).PhoneticCharacters = "ブショ" Range("D1").Select ActiveCell.FormulaR1C1 = "出庫数" With ActiveCell.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 2).PhoneticCharacters = "シュッコ" ActiveCell.Characters(3, 1).PhoneticCharacters = "スウ" Range("E1").Select ActiveCell.FormulaR1C1 = "使用量" With ActiveCell.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ActiveCell.Characters(1, 3).PhoneticCharacters = "シヨウリョウ" Range("E2").Select ActiveCell.FormulaR1C1 = "=250*RC[-1]" →ここは使用量を出すために250mlを出庫数にかけています。 Range("E2").Select Selection.AutoFill Destination:=Range("E2:E30"), Type:=xlFillDefault →商品名をコピーしています Range("E2:E30").Select Range("A2").Select Selection.AutoFill Destination:=Range("A2:A30"), Type:=xlFillDefault →出庫月をコピーしています Range("A2:A30").Select Range("B2").Select Selection.AutoFill Destination:=Range("B2:B30"), Type:=xlFillDefault Range("B2:B30").Select End Sub これで、下記のような表になる感じです。 A B C D E 商品名 出庫月 部署 出庫数 使用量 1 サニサーラ 5/1-5/31 ○ 2 500 2 サニサーラ 5/1-5/31 □ 4 1000 3 サニサーラ 5/1-5/31 ▲ 2 500 … しかし、こんなに長いマクロが、HANAさまのMacro2のようにシンプルになるんですね。すごいです! 現在は、上記の表形式で物品別に1年分のデータを入れるところまできました。 この次は、別々のシート(物品別)にある5つの項目を、部署別に1シートずつにしていければ、 と思い、とりあえず各物品別に下記のようなマクロを作成し、sheet1に病棟別にデータを集めるようなことをやっております。 Sub サニサ250コピー() ' ' サニサ250コピー Macro ' ' Range("A1:E40").Select Selection.SpecialCells(xlCellTypeVisible).Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("F1").Select ActiveSheet.Paste Range("K1").Select End Sub どこからどこまでコピーするように、というオーダーをどうすれば良いかがわからないので、部署名と物品名でフィルタしたあと、 @最大行になるであろうところまで可視セルのみコピーしてSheet1に貼付け、 A全データがそろったらシートをコピーしシート名を部署名に変える(ここは完璧に手作業です)、といった手順でしょうか。 無駄な動作がすごく多くて、ウンザリするのですが、自力ではこのあたりが限度でした。 >コードを作りますのでデータ整理後の見出しの配列と ブック内でのシートの順番を教えて下さい。 見出しの配列は、@商品名A出庫月B部署C出庫数D使用量です。 シートの順番は、A5,NICU,A6,A7,B3,EICU,B4,B5,B6,C2,C3,C4,C5,E4,W5,WC,ER,HD,外来(30外来ありますが、とりあえず)、化学療法、OPです。 よろしくお願いいたします。(Machi) ---- もしかして、元の表は ------------------------------- 1 薬品コード 薬品名称 規格 包装数 ------------------------------- 2 サニサ40 サニサーラ 250ml 1 ------------------------------- 3 部署 出庫数 出庫返品数 出庫実働数… ------------------------------- 4 あ 46 1 45 ------------------------------- 5 い 20 1 19 ------------------------------- 6 う 35 0 35 ------------------------------- って感じで、データ自体はリストになっているのですか? でしたら、話が通じなくて当然ですね。。。 とりあえず、ご呈示の「データ整理」コードは、以下の様にできると思います。 '------ Sub データ整理2() Dim mxR As Long Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("A8").Value = Range("F6").Value '→F6(元のD6)に商品名が入力されています Range("B8").Value = Range("E4").Value '→E4(元のC4)に出庫月が入力されています Rows("1:6").Delete Shift:=xlUp Range("C:C,E:J,L:R").Delete Shift:=xlToLeft Range("A1").Value = "商品名" Range("B1").Value = "出庫月" Range("C1").Value = "部署" Range("D1").Value = "出庫数" Range("E1").Value = "使用量" mxR = Range("D" & Rows.Count).End(xlUp).Row Range("E2:E" & mxR).FormulaR1C1 = "=250*RC[-1]" '→ここは使用量を出すために250mlを出庫数にかけています。 Range("A2:A" & mxR).Value = Range("A2") '→商品名をコピー Range("B2:B" & mxR).Value = Range("B2") '→出庫月をコピー End Sub '------ >最終行 = Range("B" & Rows.Count).End(xlUp).Row >Bの列の最終行までカウントしてね、とういう意味でしょうか? B列の最後に入力されているセルが何行目か教えて(変数:最終行 に入れて)ね。 と言う意味です。 >シートの順番は、A5,NICU,A6,A7,B3,EICU,B4,B5,B6,C2,C3,C4,C5,E4,W5,WC,ER,HD,外来(30外来ありますが、とりあえず)、化学療法、OPです これは元データのシートですよね? >全データがそろったらシートをコピーしシート名を部署名に変える(ここは完璧に手作業です)、といった手順 と言う事は、部署ごとのシートは新たに用意するのですね? ↓エラーが出るかもしれませんが、確認してみて下さい。 '------ Sub TEST() Dim i As Long, shi As Long, MyR As Long Dim tbl As Variant Dim ws As Worksheet For shi = 1 To 22 If Sheets(shi).Name <> "30外来" Then With Sheets(shi) tbl = .Range("A1", .Range("E" & Rows.Count).End(xlUp)).Value End With For i = 2 To UBound(tbl, 1) On Error Resume Next Set ws = Worksheets(tbl(i, 3)) On Error GoTo 0 If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:E1").Value = Array("商品名", "出庫月", "部署", "出庫数", "使用量") End If With Sheets(tbl(i, 3)) MyR = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & MyR).Value = tbl(i, 1) .Range("B" & MyR).Value = tbl(i, 2) .Range("C" & MyR).Value = tbl(i, 3) .Range("D" & MyR).Value = tbl(i, 4) .Range("E" & MyR).Value = tbl(i, 5) End With Next End If Next End Sub '------ (HANA) ---- HANAさま お手数をおかけしていてすみません。 >もしかして、元の表は… 項目名の下に数値が並んでいるわけではありませんが (2列横にずれて数値が入力されている)、 不要な列を全部削除し、新たに項目名を入力することで、提示されたような表になる感じです。 ちゃんと伝えられず申し訳ありません。 >シートの順番は、A5,NICU,A6,A7,B3,EICU,B…です これは元データのシートですよね? →元データ(業者が提出するデータ)は、物品名別または物品コード別にシートが分かれています。 物品のシート名はサニサーラ40、サニサーラ250、サニサーラ500、ウェルアップ1%、ウェルアップ5%、ベルコムローション、900708(これはできればウォッシュボンGに変更したいです)90709(ウォッシュボンピンク同左)、903488(ハンドソープ同左)、903722(シャボネット同左)です。 >全データがそろったらシートをコピーしシート名を部署名に変える… と言う事は、部署ごとのシートは新たに用意するのですね? →はい。これが、>シートの順番は、A5,NICU,A6,A7,B3,EICU,B…の部分です。 そして、外来に関しては1外来ずつのシートと、全外来一括(30外来分がすべて1つのシートに入る状態)のシートが必要です。 実際に必要となるシート名が、A5,NICU,A6,A7,B3,EICU,B4,B5,B6,C2,C3,C4,C5,E4,W5,WC,ER,HD,外来(ここに30ほどある外来すべてを集約)、化学療法、OPになります。 また、各業者ごとに微妙に部署名の入力方法が違っているため、部署項目をそのまま抜き出すことができません。(例:OPと手術室と中央手術室といった感じに、同じ部署でも業者によって違う言葉で入力されています。) 実際にデータが入ったブックでTESTを実行したところ、以下の部分にエラーがでて、コードが進みませんでした。 Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) また、他の業者のデータを整理するために使用しているマクロは、以下の通りです。 Sub 石鹸データ整理1L() ' ' 石鹸データ整理1L Macro ' ' Columns("A:A").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("B2").Select→ここで商品名をコピーしています。 Selection.Cut Destination:=Range("A5") Columns("C:C").Select Selection.Copy Columns("D:D").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("B:C,F:G,I:M").Select Range("I1").Activate Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft Rows("1:3").Select Selection.Delete Shift:=xlUp Range("A1").Select ActiveCell.FormulaR1C1 = "商品名" ActiveCell.Characters(1, 3).PhoneticCharacters = "ショウヒンメイ" Range("B1").Select ActiveCell.FormulaR1C1 = "部署" ActiveCell.Characters(1, 2).PhoneticCharacters = "ブショ" Range("C1").Select ActiveCell.FormulaR1C1 = "出庫月" ActiveCell.Characters(1, 2).PhoneticCharacters = "シュッコ" ActiveCell.Characters(3, 1).PhoneticCharacters = "ゲツ" Range("D1").Select ActiveCell.FormulaR1C1 = "出庫数" ActiveCell.Characters(1, 2).PhoneticCharacters = "シュッコ" ActiveCell.Characters(3, 1).PhoneticCharacters = "スウ" Range("E1").Select ActiveCell.FormulaR1C1 = "使用量" ActiveCell.Characters(1, 3).PhoneticCharacters = "シヨウリョウ" Range("E2").Select ActiveCell.FormulaR1C1 = "=RC[-1]*1000"→ここは1000の場合と5000の場合があります。 Range("E2").Select Selection.AutoFill Destination:=Range("E2:E49"), Type:=xlFillDefault Range("E2:E49").Select ActiveWindow.SmallScroll Down:=-12 Range("A2").Select Selection.AutoFill Destination:=Range("A2:A49"), Type:=xlFillCopy Range("A2:A49").Select ActiveWindow.SmallScroll Down:=-9 Range("A1:E1").Select Selection.AutoFilter End Sub 提出期限がせまっているので、とりあえず自分のできる方法でやっていますが、 今後はポチッと数回クリックすれば、一覧表ができるようになりたいので、 引き続きご指導お願いいたします。(Machi) ---- HANAさま 途中経過なのですが。 石鹸データ整理の部分は、HANAさまの式を参考に以下のように変えてみました。 Sub 石鹸データ整理5L() ' ' 石鹸データ整理5L Macro ' Dim mxR As Long Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("A5").Value = Range("B2").Value Columns("C:C").Select Selection.Copy Columns("F:F").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rows("1:3").Delete Shift:=xlUp Range("B:D,G:G,I:M").Delete Shift:=xlToLeft Range("A1").Value = "商品名" Range("B1").Value = "出庫月" Range("C1").Value = "部署" Range("D1").Value = "出庫数" Range("E1").Value = "使用量" mxR = Range("D" & Rows.Count).End(xlUp).Row Range("E2:E" & mxR).FormulaR1C1 = "=5000*RC[-1]" Range("A2:A" & mxR).Value = Range("A2") Range("B2:B" & mxR).Value = Range("B2") End Sub 現在、HANAさまの式で、使用量をかける部分のみ数値を変更して、それぞれの物品別に名前をつけたマクロを作成することろまで出来ました。 ---- >>シートの順番は、A5,NICU,A6,A7,B3,EICU,B…です 元データじゃないんですね。。。 >外来に関しては1外来ずつのシートと、全外来一括(30外来分がすべて1つのシートに入る状態)のシートが必要です。 これは、どういった事でしょう? A5,NICU,A6,A7・・・とかは部署名なんですよね? 挙げられているもの以外が外来 って事でしょうか? >以下の部分にエラーがでて、コードが進みませんでした。 >Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) どのようなエラーメッセージがでましたか? また、tbl(i, 3)のあたりにマウスを持っていくと ポップアップみたいなのが表示されて、内容が確認できます。 何になっていますか? >各業者ごとに微妙に部署名の入力方法が違っているため、部署項目をそのまま抜き出すことができません。 これは、同じ業者では同じ書き方をしてくれると思いますので 対応表を作って、VLOOKUP関数で参照させる様にしてはどうでしょう? >現在、それぞれの物品別に名前をつけたマクロを作成することろまで出来ました。 それは良かったです。 記録でできたコードは、動作が一つずつ記録されますし 本来必要でない動作も記録されてしまいます。 上手に直して つかってもらうと良いと思います。 ちなみに Columns("C:C").Select Selection.Copy Columns("F:F").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False の部分は、Select Selection を縮めると Columns("C:C").Copy Columns("F:F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False になりますね。 (HANA) ---- もしもエラーが 「インデックスが有効範囲に有りません」 と言ったものであれば、 >For shi = 1 To 22 の所を正しい範囲に変更して下さい。 データシートは、左から数えて 何番目から何番目迄に有るでしょうか? (HANA) ---- >提出期限がせまっているので、とりあえず自分のできる方法でやっていますが 作業はどの程度進んでいますか? 理想コードが完成するまでの暫定案として フィルタオプションの設定を利用するのはどうでしょう? 元データは一つのシートにまとめる(部署名を統一する) フィルタオプションの条件等を入力したシートを用意する 一番最初は、抽出作業をマクロの記録にとる 2番目からは、「部署」のセルを書き換えてマクロを実行 シート名は自分で変えないといけないですが、1シートずつ1部署ずつ オートフィルタを設定して、コピーして・・・ の作業をするより 時間短縮につながると思います。 (HANA) ---- HANAさま >作業はどの程度進んでいますか? 2012年1月から2013年1月までのデータに関しては、 @:元データを整理(商品名、出庫月、部署、出庫数、使用量の表にする)。 A:全期間分として、@を各物品別にシートに集約。 B:部署ごとにシートを作成し、そこにAのデータを部署別に集約。 C:Bのシートで、出庫月ごとにフィルタし、部署ごとに月別使用量として印刷している状態です。 期限が今週水曜日ですので、全て印刷して提出はしました。 今後は、各月毎にデータが渡される予定です。なので、 @:元データ(物品別のシート)を整理(商品名、出庫月、部署、出庫数、使用量の表にする)。 A:@を1つのシートにまとめる。 B:Aを部署別にして、印刷する。 といった作業をしていけば良さそうだと考えています。 TESTを実施したときのエラーは以下の通りです。 実行時エラー1004「アプリケーション定義またはオブジェクト定義のエラーです」 何となくおわかりかもしれませんが、Machiは事務職ではありません。 なので、エクセルに関する言葉が曖昧で、伝わりにくいことが多いと思います。 お手数おかけしますが、よろしくお願いします。 ---- 急ぎの作業は済んだのですね。御疲れ様でした。 今後作業自体は、月単位で良いんですよね? >実行時エラー1004「アプリケーション定義またはオブジェクト定義のエラーです」 の時、何回かループしていたら いくつかシートが作成されていると思いますが どの様な状況だったでしょうか? テストブックを作成して下さい。 元データは、3シートくらいにして 左端から並ぶ様にして下さい。 データ量も多いと大変なので、10行くらいずつに減らして下さい。 メニューからマクロの実行を行う時 ステップイン(S) を押してください。 すると、コードが前面に表示されて、黄色くハイライトされた行があると思います。 [F8]を押すと、黄色い部分が一つずつ下に下がっていきます。 どこまで進んでエラーが出るか教えてもらいたいです。 ちなみに、ローカルウィンドウを表示させると 変数の内容等確認できます。 それも併用しながら、状況を教えてもらえると良いのですが。 >エクセルに関する言葉が曖昧で、伝わりにくいことが多いと思います。 今の所、スムーズに話が進んでいると思います。 言葉が伝わりにくいのはお互い様だとおもって、こちらもご容赦願います。 (HANA) ---- HANAさま >今後作業自体は、月単位で良いんですよね? そうなりそうです(事務部が毎月データを渡してくれればですが)。 >テストブックを作成してください。 元データを3シートにして左端から3つ(物品A、物品B、物品C)並べ、データ量は10前後にしました。 物品Aのシートをアクティブにした状態で マクロの実行をステップインでF8を押していくと、 まず初めに「部署」というシートを作成し、 続いて物品Aのデータに入っている部署名すべてのシートを作成しました。 それが終わって、さらにもう1周した後に、With Sheets(tbl(i, 3)) 「インデックスが有効範囲に有りません」がエラーとして表示されました。 今回は、実行時エラー1004「アプリケーション定義またはオブジェクト定義のエラーです」 は出ませんでした。 >>For shi = 1 To 22 の所を正しい範囲に変更して下さい。 データシートは、左から数えて 何番目から何番目迄に有るでしょうか? ということは、このテストデータの場合は1 To 3にすれば良いのか?と思い修正して 再度ステップインでやってみましたが、 物品Aの部署名分シートを全て作成した後、 さらにもう1回ループしてから、With Sheets(tbl(i, 3))の部分で 同様のエラーが表示されました。 ローカルウィンドウは開いておいたものの、何がなにやらわからず…。 + : Module2 : : Module2/Module2 : i : 3 : Long : shi : 2 : Long : MyR : 3 : Long - : tbl : : Variant/Variant(1 to 13, 1 to 5) - : ws : : Worksheet/Sheet39 このあとはズラズラと出ていてどこを見れば良いのやら…です。 物品Aの部署別シートは出力されますが、物品B,Cへは進まない様子です。(Machi) ---- あ・・・・もしかして If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:E1").Value = Array("商品名", "出庫月", "部署", "出庫数", "使用量") End If の部分を If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:E1").Value = Array("商品名", "出庫月", "部署", "出庫数", "使用量") Set ws = Nothing '←追加 End If Set ws = Nothing を忘れてました。(すみません) 追加して下さい。 > このテストデータの場合は1 To 3にすれば良いのか?と思い はい、書き忘れてましたが、 1 To 3 にして下さい。 >ローカルウィンドウは開いておいたものの、何がなにやらわからず…。 : i : 3 : Long いま、iの値が「3」と言う事です。 たとえば tbl(i, 3) の所が tbl(3, 3) と書いてあるのと同じになります。 : tbl : : Variant/Variant(1 to 13, 1 to 5) tblと言う変数が、13行×5列のマス目に分かれていて tbl(3, 3)と言うと、3行目で3列目の場所を意味します。 コードの tbl = .Range("A1", .Range("E" & Rows.Count).End(xlUp)).Value 部分で、tblには、A1セルからE列の最後の行までの値を取り込みました。 データが13行目まであれば A1:E13の値が tblに写し取られていると思って下さい。 3列目は、部署が入っている列ですね。 3行目に入力されている部署名は何でしょう? ・・・・の様に考えてみて下さい。 ちなみに、 tblの所に[+]マークがあると思いますが それを開くと 各位置にどの様な値が入っているか確認できます。 また、各変数の値や 内容は、コードの該当部分にカーソルを近づけて確認もできます。 : shi : 2 : Long ここも、shiという変数が「2」と言う事です。 shiが出てくるのは >If Sheets(shi).Name <> "30外来" Then ですね。 Sheets(2)は、左から数えて2番目のシート の事です。 上のコードの意味、 左から数えて2番目のシート ・・・Sheets(2)・・・の 名前・・・・・・・・・・・・・・.Name・・・・・が 「30外来」・・・・・・・・・・・"30外来"・・・と 等しくない・・・・・・・・・・・<>・・・・・・場合 If 〜 End If の間に書いてある部分を実行する です。 まずは、コードを変更して もう一度やってみて下さい。 (HANA) ---- HANAさま Set ws = Nothingを追加し、For shi = 1 To 3に修正して、 物品Aのシートをアクティブにして再度ステップインでみていったところ、 同じ場所で、 With Sheets(tbl(i, 3)) 「インデックスが有効範囲に有りません」がエラーとして表示されました。 物品Bのシートを先頭にし、シートをアクティブにしてステップインで見ていくと、 「部署」というシートを作成後、4つ目の部署までは作成しましたが、 その後の部署は作成せず(ループだけはしていましたが)最後に、同様のエラーが表示されました。 物品Bの部署は、C4, B4, A7, B5, C4, B4, C5, C2, A8, 透析室の順で部署名が入っていますが、実際に作成されたシートは、 部署,C4, B4, A7, B5でした。また、重複している病棟のデータはちゃんと入っていました。 ローカルウィンドウには - : Module2 : : Module2/Module2 : : <変数なし> : : i : 9 : Long : shi : 1 : Long : MyR : 3 : Long + : tbl : : Variant/Variant(1 to 12, 1 to 5) + : tbl(1) : : Variant(1 to 5) + : tbl(12) : : Variant(1 to 5) : tbl(1,1) : Empty 値 : Variant/Empty : tbl(1,2) : Empty 値 : Variant/Empty : tbl(1,3) : Empty 値 : Variant/Empty : tbl(1,4) : Empty 値 : Variant/Empty : tbl(1,5) : 5000 : Variant/Double - : tbl(2) : : Variant(1 to 5) : tbl(2,1) : "商品名" : Variant/String : tbl(2,2) : "年月日" : Variant/String : tbl(2,3) : "部署" : Variant/String : tbl(2,4) : "払出数" : Variant/String : tbl(2,5) : "使用量" : Variant/String - : tbl(3) : : Variant(1 to 5) : tbl(3,1) : "ピンク" : Variant/String : tbl(3,2) : "H 24.03.31" : Variant/String : tbl(3,4) : 1 : Variant/Double : tbl(3,5) : 5000 : Variant/Double →この後tb(12)まで、すべての部署名分同様にあり - : ws : : Worksheet/Sheet6 + : Application : : Application/Application : AutoFilter : Nothing : AutoFilter + : Cells : : Range/Range (以下は抜粋です) : Count : <アプリケーション定義またはオブジェクト定義のエラーです。> : Long + : ListObjects : : ListObjects/ListObjects : CurrentArray : <該当するセルが見つかりません。> : Range : Dependents : <該当するセルが見つかりません。> : Range : MailEnvelope : <アプリケーション定義またはオブジェクト定義のエラーです。> : MsoEnvelope : Name : " B4" : String WSの+を開こうとするとOutlookの設定を求められ、それをキャンセルするとズラズラと展開される感じです。 物品Aのシートの部署はすべて違う部署名ですが、物品Bのシートの部署は同じものがいくつか混ざっている状態です。 よろしくお願いいたします。 ---- HANAさま あともう1つ気が付いたことがあります。 物品AのシートでTESTを実行した場合、作成されるシートタブが通常の4倍くらいの大きさになります。物品B・Cでは、通常のタブの大きさです。 例)(B6)と(B6 )という感じです。 ---- たびたびすみません。 修正箇所が間違ってました。。。 If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:E1").Value = Array("商品名", "出庫月", "部署", "出庫数", "使用量") Set ws = Nothing '←追加 End If ではなく If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:E1").Value = Array("商品名", "出庫月", "部署", "出庫数", "使用量") Else '←これを追加して Set ws = Nothing '←ここに入れる End If でした。 それと、タイトル行が2行目で データが3行目の様なので For i = 2 To UBound(tbl, 1) の所は i = 3 から始めてください。 「部署」ってシートが作られなくなると思います。 それから If Sheets(shi).Name <> "30外来" Then は、思い違いだったのでいらないのですが それに対応する End If も一緒にいらなくなります。 と、言う事で なんら新しい事は無いですが 一旦コードを再UPしますね。 '------ Sub TEST2() Dim i As Long, shi As Long, MyR As Long Dim tbl As Variant Dim ws As Worksheet For shi = 1 To 1 With Sheets(shi) tbl = .Range("A1", .Range("E" & Rows.Count).End(xlUp)).Value End With For i = 3 To UBound(tbl, 1) On Error Resume Next Set ws = Worksheets(tbl(i, 3)) On Error GoTo 0 If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:E1").Value = Array("商品名", "出庫月", "部署", "出庫数", "使用量") Else Set ws = Nothing End If With Sheets(tbl(i, 3)) MyR = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & MyR).Value = tbl(i, 1) .Range("B" & MyR).Value = tbl(i, 2) .Range("C" & MyR).Value = tbl(i, 3) .Range("D" & MyR).Value = tbl(i, 4) .Range("E" & MyR).Value = tbl(i, 5) End With Next Next End Sub '------ >例)(B6)と(B6 )という感じです。 の例を見ると、後ろにスペースが入っていて 大きく成っている様に感じますが。。。そうなのでしょうか? それとも、他の所とフォントが違うとかそういった事でしょうか。。。? (HANA) ---- HANAさま すごいですー!! ポチッと押すだけで、全部のデータを書き出してくれました。 >例)(B6)と(B6 )という感じです。 >の例を見ると、後ろにスペースが入っていて 大きく成っている様に感じますが。。。そうなのでしょうか? →はい、その通りです。 なぜか、このシート(物品A)の項目は、タブが通常の4倍くらいの長さになってしまいます。 他のシートは、通常通り文字数に合わせた大きさなのですが。 シートのデータ書式はすべて同じでMSPゴシックです。(Machi) ---- HANAさま あと2つお聞きしたいことがあるのですが、 例えば外科とか内科といったように「科」という字が入っているセルの文字を、 すべて「外来」に変更する、とか あらかじめ指定した文字の場合に、それを全て「外来」に変更する といったことはできるものなのでしょうか? 科別(30種類の診療科)になっているデータを、「外来」として1つに集約しなければならないのですが、 外来名はすべて違うため、TEST2のマクロをポチッとする前に、 部署名(手術室とOPと中央手術室みたいなものも含めて)を整えたいと考えています。が! >対応表を作って、VLOOKUP関数で参照させる様にしてはどうでしょう? きっとこの関数を使えばいいのだろうな…と思いつつ、 関数のヘルプを読んではみたのですが、何を言われているのかさっぱりわからず(T-T)。 現在は、置換を使用してポチポチ1つずつ変更しています。 もう1つは、今後の動きの中の、Aに関してです。 @:元データ(物品別のシート)を整理(商品名、出庫月、部署、出庫数、使用量の表にする)。 A:@を1つのシートにまとめる。 →現在は、1シート(物品)ごとにコピーして、データが重ならないようにするために、 物品AのデータをA(物品名),B(出庫月),C(部署),D(出庫数),E(使用量)に入れたら、 物品BのデータはF(物品名),G(出庫月),H(部署),I(出庫数),J(使用量)……という感じに横に張付けていくスタイルです。 最後に手作業でSheet1のデータを縦の一表にまとめています。 コピーの部分は以下のマクロを記録してやっています。 Sub サニサ250コピー() ' ' サニサ250コピー Macro Dim 最終行 As Long 最終行 = Range("C" & Rows.Count).End(xlUp).Row Range("A1:E" & 最終行).Select Selection.SpecialCells(xlCellTypeVisible).Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("A1").Select →ここで張付けるセルを選んでます。 ActiveSheet.Paste End Sub Sub サニサ500コピー() ' サニサ500コピー Macro Dim 最終行 As Long 最終行 = Range("C" & Rows.Count).End(xlUp).Row Range("A1:E" & 最終行).Select Selection.SpecialCells(xlCellTypeVisible).Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("F1").Select →今度は重ならない位置のF1を選択してます。 ActiveSheet.Paste End Sub Range("A1:E" & 最終行).Selectみたいに、 データが重ならないよう「最終行から張付け開始」といった方法はあるのでしょうか?(Machi) ---- >>後ろにスペースが入っていて >>大きく成っている様に感じますが。。。そうなのでしょうか? >→はい、その通りです。 部門別の新しいシートの名前は Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) この部分で付けています。 Sheets(2)で左から2番目のシートを表しますが Sheets(Sheets.Count)で、一番最後のシートを表せます。 ‾‾‾‾‾‾‾‾‾‾‾‾これが、「ブック内のシートをカウントした数」だからです。 ですから、先の一行は シート・・・・・・・・Sheets・・・・・・・・・・を 一番最後のシート・・・Sheets(Sheets.Count)・・・の 後ろ・・・・・・・・・after:= ・・・・・・・・・に 追加・・・・・・・・・.Add 名前を・・・・・・・・.Name tbl(i, 3)にする です。 ステップインで実行中も、この行を抜けた時 シートが追加されるのが確認出来ると思います。 物品Aのシートの部署名の部分に きっとスペースが入っているのだと思います。 マクロでスペースを削除する方法や↓と同じ手段を使う方法や 手作業で対応する方法等 色々なやり方があると思いますので、どの様にするのが良いか考えてみて下さい。 とりあえず↓から >科別(30種類の診療科)になっているデータを、「外来」として1つに集約しなければならないのですが 簡単な例を挙げてみます。 [A] [B] [C] [D] [E] [1] 動物名 シート 動物名 シート [2] いぬ いぬ さる さる [3] さる さる いぬ いぬ [4] ねこ 不明 きじ とり [5] きじ とり はと とり [6] はと とり たか とり [7] たか とり D1:E6に対応表を作ります。 D列に部署名、E列にまとめるシートの名前(統一後の名前)を一覧にします。 A列が、物品別のシートの部署名の列だと思ってください。 B列に =IF(COUNTIF($D$2:$D$6,A2),VLOOKUP(A2,$D$2:$E$6,2,FALSE),"不明") 部署ごとに分ける時、今は部署名の列(A列)を使って分けるので いぬシート、さるシート、ねこシート、きじシート、はとシート、たかシートが出来ますが シート名の列(B列)を使って分ける事にすると、 いぬシート、さるシート、不明シート、とりシート に分かれる事になります。 イメージがわかりますか? 物品Aの部署名の件も、VLOOKUP関数で済ませようとする場合は D列にさらに さる____ ←後ろにスペースを付けて 物品Aに入力されているものと同じにしたセル を増やしたらどうかと思っています。 ただし、他の場所でもスペースが入っている可能性がありますので 問題が無ければ、スペースを一括削除(置換)する事にした方が良いのかもしれません。 マクロは今、どのブックに入っていますか? 同じブック(マクロブック)に対応表を作成してもらうと良いと思います。 >Range("A1:E" & 最終行).Selectみたいに、 >データが重ならないよう「最終行から張付け開始」といった方法はあるのでしょうか? コードを作る時に、書替が必要な部分に着目して下さい。 今回は >Range("A1").Select →ここで張付けるセルを選んでます。 ここの所を書き換えていますよね? なので「あ〜、A列の入力がある最後のセルの一つ下のセルがわかればいいのに」と思って下さい。 少し上の方に戻りますが >>最終行 = Range("B" & Rows.Count).End(xlUp).Row >>Bの列の最終行までカウントしてね、とういう意味でしょうか? >B列の最後に入力されているセルが何行目か教えて(変数:最終行 に入れて)ね。 >と言う意味です。 この部分、もう少し詳しく書いておけばよかったですね。 Rows.Count は、シート全体の行数です。xlsだったら65536行目まであるので 65536 です Range("B" & Rows.Count) は Range("B65536") と書いてある事になります。 そこから .End(xlUp) = Ctrl + ↑ で移動したセル の行番号が知りたければ 後ろに .Row を付けますし、選択(Select)するなら Range("B" & Rows.Count).End(xlUp).Select こんな記述になります。 アクティブシートの最終行までの範囲を、Sheet1の続きに貼りつけるなら Dim 最終行 As Long 最終行 = Range("C" & Rows.Count).End(xlUp).Row Range("A1:E" & 最終行).Copy Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) にしてみて下さい。 単に Range("A1:E" & 最終行).Copy Range("A" & Rows.Count).End(xlUp).Offset(1) としたのでは、アクティブシートのA列の下から貼りついてしまうので Sheet("Sheet1")を付けて「Sheet1の!!」と意思表示して下さい。 ちなみに、何度か書いていますが 送られてきた情報が、今回転記する5列分以上あるのなら それらは すべて残しておくのが良いと思います。 最終的に一つのシートにまとめるのなら 項目の場所を決めて、もらえない商品の該当の列は空き列になっても 貰った情報は、いつでも使える様な形で保管しておくのが良いと思いますよ。 せっかくデータをまとめるのでしたら。 (HANA) ---- HANAさま >物品Aのシートの部署名の部分に きっとスペースが入っているのだと思います。 →入っていました!スペース。部署名の後に22〜28個のスペースがありました。 とりあえず、置換を使用して消去してみました。(Sheet1集約の部分で。) >同じブック(マクロブック)に対応表を作成してもらうと良いと思います。 集計用のブックに対応表を作成しました。 =IF(COUNTIF($H$3:$H$75,C3),VLOOKUP(C3,$H$3:$I$75,2,FALSE),"不明")という感じで、 これを最大行になるであろう辺りまでコピーしておき、それを集約したSheet1に貼付して使用してみました。 >送られてきた情報が、今回転記する5列分以上あるのならそれらは、すべて残しておくのが良いと思います。 →業者からの元データは、そのまま残してあります。 そして、今回必要とする5項目以外では今後必要となるデータはほとんどありません。 (同じ内容を違う言葉で何回も入力(出庫数、納入数、在庫数等)してある、商品の規格や薬品コード等、なので) たぶん、今後必要となりそうなのは金額なので、その部分を他の5項目と一緒に残せるようします!上手くいくか不安ですが…。 >アクティブシートの最終行までの範囲を、Sheet1の続きに貼りつけるなら… →ここは、以下のような感じで良いのでしょうか? Sub Sheet1コピー() Dim 最終行 As Long 最終行 = Range("C" & Rows.Count).End(xlUp).Row Range("A1:F" & 最終行).Copy Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) Selection.SpecialCells(xlCellTypeVisible).Select Application.CutCopyMode = False End Sub 現在、だいたい下記のような流れで実行する形にしてみました。 @:業者からの元データを「移動とコピー」から、集計用ブックにコピーする(手作業)。 A:データを必要な6項目に、それぞれ物品別で整理する。 Sub aデータ整理() 'Keyboard Shortcut: Ctrl+a Sheets("900708").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理5L" 『各データ整理のマクロは、Sub サニサ250() Dim mxR As Long Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("A8").Value = Range("F6").Value Range("B8").Value = Range("E4").Value Rows("1:6").Delete Shift:=xlUp Range("C:C,E:N,P:Q").Delete Shift:=xlToLeft Range("A1").Value = "商品名" Range("B1").Value = "出庫月" Range("C1").Value = "部署" Range("D1").Value = "出庫数" Range("E1").Value = "金額" Range("F1").Value = "使用量" mxR = Range("C" & Rows.Count).End(xlUp).Row Range("F2:F" & mxR).FormulaR1C1 = "=250*RC[-2]" Range("A2:A" & mxR).Value = Range("A2") Range("B2:B" & mxR).Value = Range("B2") End Sub こんな感じです。』 Sheets("900709").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理5L" Sheets("903488").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理1L" Sheets("903722").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理1L" Sheets("サニサーラ40").Select Application.Run "'集計用 最終版.xlsm'!サニサ40" Sheets("サニサーラ250").Select Application.Run "'集計用 最終版.xlsm'!サニサ250" Sheets("サニサーラ500").Select Application.Run "'集計用 最終版.xlsm'!サニサ500" Sheets("ベルコムローション").Select Application.Run "'集計用 最終版.xlsm'!ベルコムローション" Sheets("ウェルアップ").Select Application.Run "'集計用 最終版.xlsm'!ウェルアップ" End Sub B:Aで整理されたデータを、Sheet1に集約する。 Sub bシート1に集約() ' Keyboard Shortcut: Ctrl+b' Sheets("900708").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("900709").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("903488").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("903722").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("サニサーラ40").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("サニサーラ250").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("サニサーラ500").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("ベルコムローション").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("ウェルアップ").Select Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("Sheet1").Select Cells.Replace What:="900709-1 ウォシュボンピンク 5kg・23915 (個)", Replacement:="ピンク" _ , LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _ :=False, ReplaceFormat:=False Cells.Replace What:="900708-1 ウォシュボンG 5kg・23947 (個)", Replacement:= _ "ウォッシュボンG", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:="903488-1 弱酸性ハンドソ-プ泡 1リットル", Replacement:="ハンドソープ", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Cells.Replace What:="903722-1 シャボネットユ・ムP-5(泡状) 1リットル", Replacement:= _ "シャボネット", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Columns("C:C").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", LookAt _ :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:=" ", Replacement:="", LookAt _ :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Sheets("対応表").Select →ここが対応表をコピーしているところです。 Columns("G:I").Copy ここもきっと最終行を応用できるのでしょうが、 Sheets("Sheet1").Select どうすれば良いかわからずです。 Columns("G:G").Select ActiveSheet.Paste Cells.Select →書式を揃えてます。大小・フォント・罫線様々で見にくいので。 With Selection.Font .Name = "MS Pゴシック" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With With Selection.Font .Name = "MS Pゴシック" .Size = 12 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With →きっと1行になるんだろうな…とは思うのですが、すみません。 Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone End Sub C:対応表と部署名があっていたら、対応部署名をコピーして本来の部署の欄に値を張付け、渡す部署順に出力されるよう昇順を直す。 Sub c部署名対応と昇順並べ替え() Columns("G:G").Copy Columns("C:C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rows("1:1").Delete Shift:=xlUp Cells.Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C2:C300") _ , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "A5,NICU,A6,A7,A8,B3,ICU,B4,B5,B6,C2,C3,C4,C5,E4,西5,HD,ER,手術室,外来", DataOption _ :=xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:H300") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("I1").Select End Sub D:Sheet1のデータを部署別に出力する。 Sub d部署別出力() Dim i As Long, shi As Long, MyR As Long Dim tbl As Variant Dim ws As Worksheet For shi = 1 To 1 With Sheets(shi) tbl = .Range("A1", .Range("F" & Rows.Count).End(xlUp)).Value End With For i = 3 To UBound(tbl, 1) On Error Resume Next Set ws = Worksheets(tbl(i, 3)) On Error GoTo 0 If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:F1").Value = Array("商品名", "出庫月", "部署", "出庫数", "金額", "使用量") Else Set ws = Nothing End If With Sheets(tbl(i, 3)) MyR = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & MyR).Value = tbl(i, 1) .Range("B" & MyR).Value = tbl(i, 2) .Range("C" & MyR).Value = tbl(i, 3) .Range("D" & MyR).Value = tbl(i, 4) .Range("E" & MyR).Value = tbl(i, 5) .Range("F" & MyR).Value = tbl(i, 6) End With Next Next End Sub 以上です〜。 長文ですみません。(Machi) ---- >→入っていました!スペース。部署名の後に22〜28個のスペースがありました。 >とりあえず、置換を使用して消去してみました。(Sheet1集約の部分で。) (bシート1に集約)マクロの Columns("C:C").Select〜 の部分でしょうか? 何回かに分けて置換されている様に感じますが、何かわけがありますか? >=IF(COUNTIF($H$3:$H$75,C3),VLOOKUP(C3,$H$3:$I$75,2,FALSE),"不明")という感じで、 >これを最大行になるであろう辺りまでコピーしておき、それを集約したSheet1に貼付して使用してみました。 ・・・うまく行きますか? Sheet1と、マクロがあるブックが同じだとしても、シートは別ですよね? すると$H$3:$I$75部分は、シート間参照になると思いますが・・・。 あ、この表も含めて sheet1にコピーしてるんですね。 まずは、シート間参照の式を作ってください。 対応表が別シートにある場合の作り方がこちらに載っていますので。 http://www.excel.studio-kazu.jp/lib/e1t/e1t.html >>送られてきた情報が、今回転記する5列分以上あるのならそれらは、すべて残しておくのが良いと思います。 >→業者からの元データは、そのまま残してあります。 これは、送られてきたままの状態で残してあると言う事ですよね? どちらにしても、当然これは残しておくのが良いとは思いますが 今作っているリストは「今後使いやすい形にしておく」のが良いと思いますよ。 5列分以外のデータを、今後使うか、使わないかは別として。 データがあるとなると、今は必要ないと思っていも、今後確認したい事が出てくると思います。 5列分のデータを残しておく作業と一緒にその他のデータも作業をしておけば 「あ〜〜」ってなった時に再び作業をするよりも 時間が短縮出来ると思います。 現在行方向のデータ量が問題になっているだけで、列方向のデータ量が増えても、問題になりませんよね。 たとえば、何ml入りだったのか。もともとどういう項目名で来ていたのか。 もともとどういう部署名だったのか。 そういうのは、残しておいた方が良いです。 その他、まったく同じ値が入っているなら省いてしまってもよいかもしれませんが 「たまたま今の所同じ値が入っている」というだけなら、それもやはり リストとして、残るようにしておいた方が良いです。 近い将来金額が必要になりそうなんですよね? 遠い将来はどうでしょう? 未来はわからないので、今の段階で将来の道を狭めてしまうのは 得策ではないと思います。 >商品の規格や薬品コード等 これらが、何列分くらいあるかわからないですが。。。 これらも残す事で、現在の作業効率が著しく落ちるなら 同時に作業する事は 見合わせた方が良いのかもしれませんが。 >>アクティブシートの最終行までの範囲を、Sheet1の続きに貼りつけるなら… >→ここは、以下のような感じで良いのでしょうか? えっと、 Selection.SpecialCells(xlCellTypeVisible).Select の部分は何をさせようと思ってますか? ただ、書式を整える必要があるのなら 最初から値だけ転記するのがよさそうですね。 それと、コピーなんかも (aデータ整理)マクロでデータを整理したらただちに sheet1に貼り付け作業もやってしまえば良いと思います。 Sheets("900708").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理5L" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("900709").Select ・・・・・・ ってな感じで。 途中でマクロが止まってしまった場合の事は少し考えないといけなくなりますが。 なお、データ整理のマクロの Range("A1").Value = "商品名" Range("B1").Value = "出庫月" Range("C1").Value = "部署" Range("D1").Value = "出庫数" Range("E1").Value = "金額" Range("F1").Value = "使用量" 部分は >Range("A1:F1").Value = Array("商品名", "出庫月", "部署", "出庫数", "金額", "使用量") この部分と一緒です。 (6行に分かれていた方が、わかりやすいかもしれませんが?) まだいろいろありますが、まずはこのあたりでどうでしょう? (HANA) ---- HANAさま > 何回かに分けて置換されている様に感じますが、何かわけがありますか? スペースの量が文字数によって違っていたため、28個のスペースをスペース0個に置換、27個の…26個の…という感じに、1個1個やっていったためです。 置換の方法はそれ以外知らないもので、すみません。 「この列のスペースは全部削除して」というようなやり方もできるのでしょうか? >まずは、シート間参照の式を作ってください。 →もう、本当にすみません。 この対応表コピーすればいいのかな?などと考えていました。 対応表のシート名は「対応表」なので、 =IF(COUNTIF(対応表!$H$3:$H$75,C3),VLOOKUP(C3,対応表!$H$3:$I$75,2,FALSE),"不明")を、Sheet1のG列に入れたのですが、良いでしょうか? >たとえば、何ml入りだったのか。もともとどういう項目名で来ていたのか… →商品名に、薬品コード、商品名、規格、納入コード、梱包単位がすべて入っています。 900709-1 ウォシュボンピンク 5kg・23915 (個)←こんな感じです。 長くて見にくいかな、と思いリネームしてしまいましたが、 指摘していただいた内容を考えると、商品名をそのまま残すほうが安全かな、と考えなおしました。 >その他、まったく同じ値が入っているなら省いてしまってもよいかもしれませんが… この部分は、業者さんに問い合わせたところ、 他にも色々な施設に納品しているため、その施設用に言葉が違っているだけで、 内容はすべて同じとのことでしたので、ここは大丈夫そうです。 >えっと、 Selection.SpecialCells(xlCellTypeVisible).Select の部分は何をさせようと思ってますか? →多分、使用量を出すために入っている数式があるので、値のみをコピーしようとしたんだと思うのですが、 実際にSheet1に書き出されたデータは、数式ごとコピーされているので、どこかで失敗しているのですね(>_<)。もう一度やりなおしてみます。 >それと、コピーなんかも (aデータ整理)マクロでデータを整理したらただちに sheet1に貼り付け作業もやってしまえば良いと思います。 途中でマクロが止まってしまった場合の事は少し考えないといけなくなりますが。 →最終的に、1つになるとすっごく嬉しいです。 ただ、2012年の12か月分のデータの中に、何度か書式が違う (データが入力されているセルが違う、物品のシート名が違う等。 他の施設にも提出しているためか、時々混ざっちゃうんだそうです。)ものがあったため、その対処が不安です。(Machi) ---- >「この列のスペースは全部削除して」というようなやり方もできるのでしょうか? 置換前の文字に スペースを一つ。 置換後の文字に何も入力せずに、すべて置換してみて下さい。 >=IF(COUNTIF(対応表!$H$3:$H$75,C3),VLOOKUP(C3,対応表!$H$3:$I$75,2,FALSE),"不明")を、 >Sheet1のG列に入れたのですが、良いでしょうか? そうですね。 後はこの式をVBAが入力してくれるようにすると良いと思います。 当初の私が思い違いをしていた頃に、記録マクロで数式を入力しましたよね。 そんな感じで 「C3:C10を選択して 数式を入力して Ctrl+Enter で確定」を 記録にとってみて下さい。 実行すると、C3:10に数式が入るコードが完成しますので 10行目までではなく、データのある最終行迄入力される様にすれば良いですね。 >→商品名に、薬品コード、商品名、規格、納入コード、梱包単位がすべて入っています。 でしたら、この列はそのまま残しておいて 必要な所だけ抜き出す とか ここもVLOOKUP関数でわかりやすい表示を参照するとか してはどうですか? >実際にSheet1に書き出されたデータは、数式ごとコピーされているので、どこかで失敗しているのですね(>_<)。 いや、もともと数式ごとコピーする様なコードになってます。 後から書式の設定などをしている様なので 元からデータだけを参照できる様にしておくのがよさそうですね。 たとえば Range("A8").Value = Range("F6").Value で、F6セルの値がA8セルに入力された様に ↓きっと細かい修正が必要になってくると思いますが Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(最終行, 6).Value = Range("A1:F" & 最終行).Value 最終行が「10」だった場合 Sheet1のA列の続きの10行6列の範囲にA1:F10の範囲の値が入力されます。 >ただ、2012年の12か月分のデータの中に、何度か書式が違う >ものがあったため、その対処が不安です そうですね。 作業前に、想定している場所に 想定しているものがあるかどうか 確認しておいた方がよさそうですね。 商品シートは9枚ある様ですが、様式は全部違うのですか? (HANA) ---- HANAさま 返信が遅くなり申し訳ありません。 >置換前の文字に スペースを一つ。 >置換後の文字に何も入力せずに、すべて置換してみて下さい。 Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False 半角スペースの部分と全角スペースの部分があったために、 上記のだけでは、全部消えなかったようでした。 なので、Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _ xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False もう1つ、↑を入れたところ、すべてのスペースが削除されました。 >=IF(COUNTIF(対応表!$H$3:$H$75,C3),VLOOKUP(C3,対応表!$H$3:$I$75,2,FALSE),"不明")を、 >後はこの式をVBAが入力してくれるようにすると良いと思います。 >当初の私が思い違いをしていた頃に、記録マクロで数式を入力しましたよね。 これは、↓みたいな感じで良いでしょうか? Sub c部署名対応() Dim mxR As Long Range("G2").Select ActiveCell.FormulaR1C1 = "対応名" mxR = Range("C" & Rows.Count).End(xlUp).Row Range("G3:G" & mxR).Select Selection.FormulaR1C1 = _ "=IF(COUNTIF(対応表!R3C8:R75C8,RC[-4]),VLOOKUP(RC[-4],対応表!R3C8:R75C9,2,FALSE),""不明"")" End Sub >>→商品名に、薬品コード、商品名、規格、納入コード、梱包単位がすべて入っています。 >でしたら、この列はそのまま残しておいて 必要な所だけ抜き出す とか >ここもVLOOKUP関数でわかりやすい表示を参照するとか してはどうですか? そうですね、やってみます! >いや、もともと数式ごとコピーする様なコードになってます。 うわぁ…。すみません。マクロの記録の時に、 可視セルのみコピーってしたと思っていたのですが、やっていなかったんですね、わたし。 >たとえば Range("A8").Value = Range("F6").Value で、F6セルの値がA8セルに入力された様に ↓きっと細かい修正が必要になってくると思いますが Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(最終行, 6).Value = Range("A1:F" & 最終行).Value 最終行が「10」だった場合 Sheet1のA列の続きの10行6列の範囲にA1:F10の範囲の値が入力されます。 Sub Sheet1コピー() Dim 最終行 As Long 最終行 = Range("C" & Rows.Count).End(xlUp).Row Range("A1:F" & 最終行).Copy Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) End Sub これを、 Sub Sheet1コピー() Dim 最終行 As Long 最終行 = Range("C" & Rows.Count).End(xlUp).Row (→この部分が必要かわからなかったのですが取敢えずそのまま残しました。) Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(最終行, 6).Value = Range("A1:F" & 最終行).Value End Sub これに変更すれば良いのでしょうか? 実行すると、Sheet1にコピーされた時点で、書式が全部揃っています! Resizeという部分で、↑ができるようになるのでしょうか?感動です〜。 >商品シートは9枚ある様ですが、様式は全部違うのですか? 様式は3種類ですが、そのうち1種類はデータの項目名や書式が違うだけなので、 実質は、2種類となります。 (Machi) ---- >半角スペースの部分と全角スペースの部分があったために、 〜〜 >〜〜 すべてのスペースが削除されました。 そうですね。 そうしてもらえると良いと思います。 >これは、↓みたいな感じで良いでしょうか? >Sub c部署名対応() それでうまくいってるなら、良いと思います。 もう一歩進んでみますと。。。 とりあえずSelectをなくしましょう。 '------ Dim mxR As Long Range("G2").Value = "対応名" mxR = Range("C" & Rows.Count).End(xlUp).Row Range("G3:G" & mxR).FormulaR1C1 = _ "=IF(COUNTIF(対応表!R3C8:R75C8,RC[-4]),VLOOKUP(RC[-4],対応表!R3C8:R75C9,2,FALSE),""不明"")" '------ >マクロの記録の時に、 >可視セルのみコピーってしたと思っていたのですが、やっていなかったんですね、わたし。 いえ、その後私が書き換えた時に、値化に対応してなかったのです。 すみません。 >Resizeという部分で、↑ができるようになるのでしょうか?感動です〜。 残念ながら 違います。。。 たとえば Range("A1").Copy Range("B1") これは、A1セルをコピーして B1セルに貼りつけなさい。と言う指令です。 すると、A1セルに設定している書式なども一緒に貼りつきます。 数式が入っていたら、数式の状態で貼りつきます。 通常のコピペって そーゆーもの ですよね? そして Range("B1").Value = Range("A1").Value これは、A1セルの内容をB1セルにいれなさい。と言う指令です。 書式は引き継がれませんし、数式が入っていたらその結果が転記されます。 Machiさんが、A1セルの表示を見て B1セルに入力しなおす イメージです。 Resizeと言うのは、ワークシート関数で OFFSET(基準, 行数, 列数, [高さ], [幅])ってのがあると思いますが [高さ][幅]で指定するのと同じ様なイメージです。 たとえば、OFFSET(A1,,,10,6) と書いてあったら A1セルを基準に10行×6列の範囲 を表します。 OFFSET(A1,1,,10,6)だと、A1セルから一つ下がって10行×6列の範囲・・・A2:F11・・・の事です。 VBAの方に帰って、コードに似せた例にすると Sheets("Sheet1").Range("A1").Offset(1).Resize(10, 6) Sheet1のA1セルから一つ下がって10行×6列の範囲 です。 Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(最終行, 6).Value = Range("A1:F" & 最終行).Value この部分は Sheet1のA列の入力がある最後のセルの一つ下から 変数:最終行 に入っている行数×6列の範囲に 現在アクティブになっているシートの、"A1:F" & 最終行 の範囲の値を入れなさい。 と、書いてある事になります。 ×書式がそろっている ○コピー元の書式を引き継いでいない と言う事なんですが、納得出来そうですか? (HANA) ---- HANAさま >×書式がそろっている >○コピー元の書式を引き継いでいない >と言う事なんですが、納得出来そうですか? はい、説明頂いた内容はわかりました。 何が関数で何がVBAなのか、区別もつきませんで、すみませんm(_ _)m。 (Machi) ---- HANAさま 部署名などを対応表に沿って変換してから、出力する部署名順に並べかえるようにしました。 Sub c部署名対応と昇順並べ替え() Dim mxR As Long Range("G2").Select ActiveCell.FormulaR1C1 = "対応名" mxR = Range("C" & Rows.Count).End(xlUp).Row Range("G3:G" & mxR).Select Selection.FormulaR1C1 = _ "=IF(COUNTIF(対応表!R3C8:R75C8,RC[-4]),VLOOKUP(RC[-4],対応表!R3C8:R75C9,2,FALSE),""不明"")" Rows("1:1").Delete Shift:=xlUp Cells.Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G2:G300") _ , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "A5,NICU,A6,A7,A8,B3,ICU,B4,B5,B6,C2,C3,C4,C5,E4,西5,HD,ER,手術室,外来", DataOption _ :=xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:H300") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub このあと、対応名でシートを出力したかったので、 HANAさまに頂いたマクロを、以下のように変えてみたのですが、 そうしたら、最初の部署になるA5だけシートが出力されなくなってしまいました。 Sub d部署別出力() Dim i As Long, shi As Long, MyR As Long Dim tbl As Variant Dim ws As Worksheet For shi = 1 To 1 With Sheets(shi) tbl = .Range("A1", .Range("G" & Rows.Count).End(xlUp)).Value End With For i = 7 To UBound(tbl, 1) On Error Resume Next Set ws = Worksheets(tbl(i, 7)) On Error GoTo 0 If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 7) Sheets(tbl(i, 7)).Range("A1:G1").Value = Array("商品名", "出庫月", "部署", "出庫数", "金額", "使用量", "対応名") Range("A1:G1").Select Selection.AutoFilter Range("H1").Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[-2])" Else Set ws = Nothing End If With Sheets(tbl(i, 7)) MyR = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & MyR).Value = tbl(i, 1) .Range("B" & MyR).Value = tbl(i, 2) .Range("C" & MyR).Value = tbl(i, 3) .Range("D" & MyR).Value = tbl(i, 4) .Range("E" & MyR).Value = tbl(i, 5) .Range("F" & MyR).Value = tbl(i, 6) .Range("G" & MyR).Value = tbl(i, 7) End With Next Next End Sub やりかたを間違えているのでしょうが、どこを直せば良いのかわかりません。 よろしくお願いいたします。(Machi) ---- HANAさま 作成したマクロを全部つなげてみました。 どのようにつなげるべきなのか、わからなかったので とりあえず、行をあけて貼り付けてあります。 対応名の部分は、応急処置として 対応名項目列をC列に移動させることで、全部出力されるようになりました。 物品名のVLOOKUPは、これから入れる予定です。 Sub ★一括整理() Sheets("900708").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理5L" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("900709").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理5L" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("903488").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理1L" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("903722").Select Application.Run "'集計用 最終版.xlsm'!石鹸データ整理1L" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("サニサーラ40").Select Application.Run "'集計用 最終版.xlsm'!サニサ40" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("サニサーラ250").Select Application.Run "'集計用 最終版.xlsm'!サニサ250" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("サニサーラ500").Select Application.Run "'集計用 最終版.xlsm'!サニサ500" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("ベルコムローション").Select Application.Run "'集計用 最終版.xlsm'!ベルコムローション" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("ウェルアップ1L").Select Application.Run "'集計用 最終版.xlsm'!ウェルアップ" Application.Run "'集計用 最終版.xlsm'!Sheet1コピー" Sheets("Sheet1").Select Cells.Replace What:="900709-1 ウォシュボンピンク 5kg・23915 (個)", Replacement:="ピンク900709-1 ウォシュボンピンク 5kg・23915 (個)" _ , LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _ :=False, ReplaceFormat:=False Cells.Replace What:="900708-1 ウォシュボンG 5kg・23947 (個)", Replacement:= _ "ウォッシュボンG900708-1 ウォシュボンG 5kg・23947 (個)", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:="903488-1 弱酸性ハンドソ-プ泡 1リットル", Replacement:="ハンドソープ903488-1 弱酸性ハンドソ-プ泡 1リットル", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _ False, ReplaceFormat:=False Cells.Replace What:="903722-1 シャボネットユ・ムP-5(泡状) 1リットル", Replacement:= _ "シャボネット903722-1 シャボネットユ・ムP-5(泡状) 1リットル", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _ xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _ xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Dim mxR As Long Range("G2").Select ActiveCell.FormulaR1C1 = "対応名" mxR = Range("C" & Rows.Count).End(xlUp).Row Range("G3:G" & mxR).Select Selection.FormulaR1C1 = _ "=IF(COUNTIF(対応表!R3C8:R75C8,RC[-4]),VLOOKUP(RC[-4],対応表!R3C8:R75C9,2,FALSE),""不明"")" Rows("1:1").Delete Shift:=xlUp Cells.Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G2:G300") _ , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "A5,NICU,A6,A7,A8,B3,ICU,B4,B5,B6,C2,C3,C4,C5,E4,西5,HD,ER,手術室,外来", DataOption _ :=xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:H300") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Columns("G:G").Select Selection.Cut Columns("C:C").Select Selection.Insert Shift:=xlToRight Dim i As Long, shi As Long, MyR As Long Dim tbl As Variant Dim ws As Worksheet For shi = 1 To 1 With Sheets(shi) tbl = .Range("A1", .Range("G" & Rows.Count).End(xlUp)).Value End With For i = 2 To UBound(tbl, 1) On Error Resume Next Set ws = Worksheets(tbl(i, 3)) On Error GoTo 0 If ws Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = tbl(i, 3) Sheets(tbl(i, 3)).Range("A1:G1").Value = Array("商品名", "出庫月", "対応名", "部署", "出庫数", "金額", "使用量") Range("A1:G1").Select Selection.AutoFilter Range("H1").Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[-1])" Else Set ws = Nothing End If With Sheets(tbl(i, 3)) MyR = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & MyR).Value = tbl(i, 1) .Range("B" & MyR).Value = tbl(i, 2) .Range("C" & MyR).Value = tbl(i, 3) .Range("D" & MyR).Value = tbl(i, 4) .Range("E" & MyR).Value = tbl(i, 5) .Range("F" & MyR).Value = tbl(i, 6) .Range("G" & MyR).Value = tbl(i, 7) End With Next Next End Sub つなげ方がわかりませんが、こんな感じで良いのでしょうか? (Machi) ---- >そうしたら、最初の部署になるA5だけシートが出力されなくなってしまいました。 なんでしょうねぇ。。。 >対応名項目列をC列に移動させることで、全部出力されるようになりました。 のコードと見比べると、列の位置だけが違うなら >For i = 7 To UBound(tbl, 1) >For i = 2 To UBound(tbl, 1) この部分が違っているのは、おかしいです。 この i は「行数」として使ってます。 なので、データが2行目から始まっているなら 2 のままで良いのですが。 >つなげ方がわかりませんが、こんな感じで良いのでしょうか? 下にコピペして、続けて実行される様にしても良いと思いますが 商品毎のデータを整理する所で Application.Run "'集計用 最終版.xlsm'!石鹸データ整理5L" ってやってますよね? そんな感じでやっておくのが、すっきりすると思います。 単独で実行したいこともあるかもしれませんので。 ちなみに、シートを一つにしてからの作業になりますので For shi = 1 To 1 ・・・と、それに対応する・・・Next をなくして With Sheets(shi) 部分で、直接シート名を指定 With Sheets("Sheet1") で良いと思います。 >何が関数で何がVBAなのか、区別もつきませんで 私が気軽に「関数」と言っているから、わかりにくいと思います。すみません。 今、私が「関数」で表したい事は シートのセルに数式を埋め込む と言う事です。 VBAにはVBAの関数が有ったり、VBAでもワークシート関数が使えたりするのですが 「Machiさんが、セルに数式を入れるのと同じ様に VBAに、セルに数式を入れてもらいましょう。 VBAより、数式の方が敷居が低くて考えやすいだろうから。」 って思ってます。 少し脱線しますが '------ Sub VBAで足し算() Range("C1").Value = Range("A1").Value + Range("B1").Value End Sub '------ Sub 数式で足し算() Range("C2").FormulaR1C1 = "=SUM(RC[-2]:RC[-1])" End Sub '------ VBAで足し算 を実行すると、A1+B1の結果がC1セルに入力されます。 このコードを書くためには それぞれのセルを表したい時、どの様に書くのか。 足し算をさせたい時、どの様に書くのか。 知っておかないといけません。 数式で足し算 を実行すると、C2セルに =SUM(A2:B2) の式が入力されるので、 C2セルに A2+B2 の 結果が表示される事になります。 このコードは、マクロの記録で 1.C2セルを選択 2.=SUM(A2:B3) の式を入力 をコード化して、不要部分を削除すると完成します。 Range("C2").Select ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])" Range("C3").Select 2行目の「ActiveCell」が、その上の「Range("C2")」の事なので、置き換えられる。 3行目の C3セルを選択する動作は必要ないので、消してOK 。。。。って事を知っておかないと完成はしませんが。。。 『足し算』という簡単な例なので いまいちピンとこないかもしれませんが VLOOKUP関数をセルに埋める Selection.FormulaR1C1 = _ "=IF(COUNTIF(対応表!R3C8:R75C8,RC[-4]),VLOOKUP(RC[-4],対応表!R3C8:R75C9,2,FALSE),""不明"")" と、同じ結果が得られる様なコードを書く 事を考えてみてもらうと、多くの事を知らなくても結果が得られていると 実感してもらえるのではないかと思いますが、どうでしょう? あ・・・もしかして Resizeの説明の所で ワークシート関数のOFFSET関数を持ち出したのが 混乱させちゃいましたか? ちなみに、d部署別出力のコードは 元データが一つにまとまったり 部署別出力するまでに並べ替えが行われたりしているので 上で書いた所以外も、もう少し変更できる所があります。 そのあたりも修正していけたら良いと思います。 が、まずは 商品毎シートでデータをまとめる所がもう少し何とかしたい感じです。 >>商品シートは9枚ある様ですが、様式は全部違うのですか? >様式は3種類ですが、そのうち1種類はデータの項目名や書式が違うだけなので、 >実質は、2種類となります。 ここの所を、もっと詳しく教えてもらえませんか? 出来るだけ同じコードで済む様にしておくのが良いと思います。 完成しているコードで、同じ所と違う所を見極めて教えて下さい。 (HANA) ---- HANAさま >For i = 7 To UBound(tbl, 1) >For i = 2 To UBound(tbl, 1) >この部分が違っているのは、おかしいです。 >この i は「行数」として使ってます。 行数だったのですね(>_<)。 HANAさまに頂いたときは、For i = 3 To UBound(tbl, 1)だったんです。 そして、tbl(i,3)の部分をシート名として書き出していたので、 今度はtbl(i, 7)のとこを書き出すのだから、全部7にすればいいのかなと考えて、 それまで3という数字が入っていた部分を、訳も分からず全部7に変えちゃったのです。 だから、7行目のデータからしか読み込まなかったんですね…。 応急処置で変更しているときに、3だと1行データが足りなくなることに気づき、 ステップインで動作を見ていて、2に変えたような気がします。すみません! >>様式は3種類ですが、そのうち1種類はデータの項目名や書式が違うだけなので、 実質は、2種類となります。 >ここの所を、もっと詳しく教えてもらえませんか? 様式1と様式2は、データの項目名と書式がちがっていますが、 ありがたいことに、必要な項目データの入っている列が同じです。 なので、コードは同じものを使用(使用量をかけるところを除いて)できます。 (Application.Run "'集計用 最終版.xlsm'!石鹸データ整理5L"と、 Application.Run "'集計用 最終版.xlsm'!石鹸データ整理1L"がそれにあたります。) 残りの様式3は、項目名が変わることがありますが、配置される列や行は変更ないことが多い(時々、行がずれて違う場所にありますが)です。 ただ、たびたびワークシートのシート名が変わっているため、それによるエラーが出ます。 (実行する前にしっかり確認すればいいのでしょうが、同じシート名でも数字や英字が半角だったり全角だったりするため、見た目で判別し辛いことが残念です) こちらは、Application.Run "'集計用 最終版.xlsm'!サニサ40"とかです。 違う部分は容量の数値部分のみです。 サニサ40が40ml、サニサ250が250ml、サニサ500が500ml、ベルコムローションも500ml、ウェルアップローションは1000mlと500mlです。ウェルアップローションの500mlは月によってシートがあったりなかったりなので、 今はマクロに入れていない状態です。 (Machi) ---- >HANAさまに頂いたときは、For i = 3 To UBound(tbl, 1)だったんです。 はい、上の方の段階では 1行目に合計があって 2行目に見出しがあって 3行目からデータ になっていた様でしたので、iは「3」から始めました。 >3だと1行データが足りなくなることに気づき、 >ステップインで動作を見ていて、2に変えたような気がします。すみません! いいえ、この様にして 作ってあるコードと実際の動きを確認しながら 希望の動きに変更して行って下さい。 iが7行目から始まっていると、ステップインで実行していくと 一回目のループで tbl(i, 7) にポインタを近づけた時 想定した「A5」ではなく、「NICU」とかが表示されて ・・・???・・・ ってのがわかったと思います。 最初の内は、ステップインで実行中もどこの何を見れば良いのか 分からないと思いますが「何がわかれば良いのか」を考えながら トライしてもらうと、そのうちわかってくると思います。 >様式1と様式2は、データの項目名と書式がちがっていますが、 今、置換の所で 「900709-1 ウォシュボンピンク 5kg・23915 (個)」 こんなのを検索してますね。 このセルに入力されてくる文字は、毎回同じでしょうか? 同じであれば、これをキーにして 数量や置換後に表示したい文字を VLOOUP関数で参照させることにすると 容量部分も共通化が出来ると思いますが、どうなんでしょう? また >配置される列や行は変更ないことが多い(時々、行がずれて違う場所にありますが) これは、ずれにもパターンがあると思いますが、どの項目がどの位置にずれる事があるのでしょう? 「行がずれる」って事は、項目名などが入力されている部分に関してですよね? ずれている場合は、データの開始行も一緒にずれるのでしょうか? でしたら逆に、データの見出しがどの行にあるかがわかれば ずれているかどうか判断できるのでしょうか? (HANA) ---- HANAさま >このセルに入力されてくる文字は、毎回同じでしょうか? はい、同じです。 置換をかけている4種類の物品が、様式1と2のタイプになります。 それ以外の物品が、様式3になります。 様式3の物品名は、サニサーラ(W)40mlという感じで、 薬品コードなどは入っていないので、置換せずそのまま使用しています。 >VLOOUP関数で参照させることにすると >容量部分も共通化が出来ると思いますが、どうなんでしょう? この、「容量部分の共通化」というのはどういう意味でしょうか? 5kgとか1gとか、それぞれの物品の容量の部分のマクロのことでしょうか。 >ずれている場合は、データの開始行も一緒にずれるのでしょうか? はい、そうです。 データが表になっているので、ずれていればすぐにわかります。 表の開始位置が通常はA1からなのに対し、C5とかD5とか開始位置が変わっているという状態です。 確認したところ、シートの真ん中にあった方が、見やすいのではないか?という配慮だそうです。 これに関しては、事務の方にいつもA1に貼付けてくれるよう依頼したので、 多分、今後はなくなるはず!と思っています。 データのシート名に関しては、事務の方では統一は難しそうなので、 こちらでしっかり確認していくしかないな、と考えています。 (Machi) ---- >この、「容量部分の共通化」というのはどういう意味でしょうか? それぞれの商品によってコードを変えているのは 商品によって容量が違っているからですよね。 具体的には、表をもう一つ作って 最初の列に 900709-1 ウォシュボンピンク 5kg・23915 (個) の様に、もらうデータに入力されているものを羅列。 たとえば、次の列に容量 5 そして、その次の列に人が見てわかりやすい様に変更した文字 ウォシュボンピンク 5kg を入れておきます。 Sheet1にデータをすべて集めた後 使用量を出す列には =数量のセル*VLOOKUP(品名のセル,表の範囲,2,FALSE) 人が見る品名の列には =VLOOKUP(品名のセル,表の範囲,3,FALSE) といった式をマクロでいれる。 すると、データを整理する部分のコードは様式の数だけ(二つだけ)用意しておけば良いですよね? また、何か変更があったり 追加があった場合も この表を変更するだけで対応出来ると思いますし。 >シートの真ん中にあった方が、見やすいのではないか?という配慮だそうです。 >これに関しては、事務の方にいつもA1に貼付けてくれるよう依頼したので でしたら良かったですね。 >データのシート名に関しては、事務の方では統一は難しそうなので、 これは、データを整理する部分のコードが二つ(あるいは三つ)にまとめられるなら どちらの様式なのか判断して目的の方を自動的に実行させる様に出来ると思います。 まずは、データを整理するコードが二つに出来るか、検討してみて下さい。 その後、どのセルがどうなっている時どちらの様式と判断出来るのか 教えてください。 (HANA) ---- HANAさま >すると、データを整理する部分のコードは様式の数だけ(二つだけ)用意しておけば良いですよね? HANAさまに言われたとおりに表を作り、 よくわからないながらも、取りあえずVLOOKUPを入れてみて、 やっと、なるほど!!こういうことだったんだ。とわかりました。 便利なものですね〜。感動します、ほんとに。 2つの様式分のデータ整理用マクロは、 使用量を掛けていた部分を削除して、こんな感じになりました。 上から3行目から7行目までが、様式によって変わります。 Sub 消毒薬() Dim mxR As Long Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("A8").Value = Range("F6").Value Range("B8").Value = Range("E4").Value Rows("1:6").Delete Shift:=xlUp Range("C:C,E:N,P:Q").Delete Shift:=xlToLeft Range("A1").Value = "商品名" Range("B1").Value = "出庫月" Range("C1").Value = "部署" Range("D1").Value = "出庫数" Range("E1").Value = "金額" Range("F1").Value = "使用量" Range("G1").Value = "表示病棟名" Range("H1").Value = "表示商品名" mxR = Range("C" & Rows.Count).End(xlUp).Row Range("A2:A" & mxR).Value = Range("A2") Range("B2:B" & mxR).Value = Range("B2") 違う部分は、 Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("A5").Value = Range("B2").Value Columns("C:C").Select Selection.Copy Columns("F:F").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rows("1:3").Delete Shift:=xlUp Range("B:D,G:G,I:J,L:M").Delete Shift:=xlToLeft 以上です。 参照させる部分は、昇順並べ替えも入ってますが、以下で良いでしょうか? 対応表は、A2からC10まで入力してあって、HANAさまのご提案通り、 A商品名、B容量、C表示商品名の順で入れてあります。 H3からI75には、部署名の対応表があります。 Dim mxR As Long mxR = Range("C" & Rows.Count).End(xlUp).Row Range("G3:G" & mxR).Select Selection.FormulaR1C1 = _ "=IF(COUNTIF(対応表!R3C8:R75C8,RC[-4]),VLOOKUP(RC[-4],対応表!R3C8:R75C9,2,FALSE),""不明"")" Range("F3:F" & mxR).Select Selection.FormulaR1C1 = "=RC[-2]*VLOOKUP(RC[-5],対応表!R2C1:R10C3,2,FALSE)" Range("H3:H" & mxR).Select Selection.FormulaR1C1 = "=VLOOKUP(RC[-7],対応表!R2C1:R10C3,3,FALSE)" Rows("1:1").Delete Shift:=xlUp Cells.Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("G2:G300") _ , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "A5,NICU,A6,A7,A8,B3,ICU,B4,B5,B6,C2,C3,C4,C5,E4,西5,HD,ER,手術室,外来", DataOption _ :=xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:H300") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 以上です。 >どのセルがどうなっている時どちらの様式と判断出来るのか 教えてください。 物品別シートの元データの部分で良いのでしょうか? 様式1,2では、常にA1セルに[9]SPDと入力されています。 様式3では、 出庫があった場合は、A1のセルに必ず施設名が入ります。 出庫がない場合は、出庫なし、出庫数なしなど、毎回違う言葉が違うセルに入力されています。これは、事務の方が入力するわけではなく元データそのものなんだそうです。 (Machi) ---- もう少し考えを変えても良いでしょうか? 今は、商品毎のシートでデータを整理して 整理されたデータを Sheet1 にコピーしてますよね? もともと 商品毎に分かれたシートから部署毎に抽出予定でしたので。 ですが こうなると、直接 Sheet1にコピーしながらデータを作っていけば良いんじゃないでしょうか? そしたら、元のシートがそのまま残るので 何か問題(列がずれているパターンだった 等) があった時に、手作業での修正処理が簡単になると思います。 そこで 「消毒薬(様式1,2?)」は、 A列(商品名)に D6 B列(出庫月)に C4 C列(部 署)に D8以降 D列(出庫数) 空き(後で数式を入れる) E列(金 額)に ・・・・ の様に元のシートからの対応を書いてみてもらえますか? そして、Sheet1のデータには あとからわかりやすい様に 元シート名を入れる列も追加しておくのが良いと思います。 >参照させる部分は、昇順並べ替えも入ってますが、以下で良いでしょうか? そうですね。 病棟名を参照する部分は、COUNTIF関数でエラーチェックをしていますが 出庫数と商品名を参照する部分はエラーチェックをしてないので (まぁ、エラーになるだけですが。。。)エラーチェックを入れておいても良いかもしれません。 また、マクロの記録から作っているので どうしても R1C1形式で記録されています。 セルに入力する様な形に直しておいた方がわかりやすい。。。かな? Range("G3:G" & mxR).Formula = _ "=IF(COUNTIF(対応表!$H$3:$H$75,C3),VLOOKUP(C3,対応表!$H$3:$I$75,2,FALSE),""不明"")" って感じで。 この「75」の部分も変数にして 増減に対応できるようにしたいですね。 (これはもう少し後の話にしますが。) >物品別シートの元データの部分で良いのでしょうか? はい、そのつもりで書きました。 >様式1,2では、常にA1セルに[9]SPDと入力されています。 これは「消毒薬」マクロを実行するシート って事でしょうか? >様式3では、出庫があった場合は、A1のセルに必ず施設名が入ります。 出庫が無い場合は、Sheet1に何かデータを追加しますか? また、出庫が無かった場合 8行目以降(?)のデータはどの様になっているのでしょう? (HANA) ---- HANAさま >>様式1,2では、常にA1セルに[9]SPDと入力されています。 >これは「消毒薬」マクロを実行するシート って事でしょうか? こちらが「石鹸」マクロを実行するシートです。 >出庫が無い場合は、Sheet1に何かデータを追加しますか? Sheet1にデータを追加することはないです。 >また、出庫が無かった場合 8行目以降(?)のデータはどの様になっているのでしょう? 出庫がなかった場合は、「出庫なし」などの文字がセルのどこかに入力されていますが、 それ以外は全く何も入力されていない空シートです。 >元のシートからの対応を書いてみてもらえますか? 元シートからの対応といいますと、以下のような書き方で伝わりますか? (見当違いな返答でしたらすみません。) Sub 消毒薬() Dim mxR As Long Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove →商品名と出庫月を移すための列を作成し、 Range("A8").Value = Range("F6").Value '→元D6の商品名をA8に移し、 Range("B8").Value = Range("E4").Value '→元C4の出庫月をB8に移し、 Rows("1:6").Delete Shift:=xlUp →不要になった1-6行を削除して、 Range("C:C,E:N,P:Q").Delete Shift:=xlToLeft →不要なデータと空の列を削除して、 Range("A1").Value = "商品名" →(D6から移した商品名がA2にのみ入力されている列) Range("B1").Value = "出庫月" →(C4から移した出庫月(文字列)がB2にのみ入力されている列) Range("C1").Value = "部署" →(元はB8列に入力されていた各部署名が入力されている列) Range("D1").Value = "出庫数" →(元はI8列に入力されていた出庫数が入力されている列)、 Range("E1").Value = "金額" →(元はP8列に入力されていた金額が入力されている列) Range("F1").Value = "使用量" →空の列(VLOOKUPが入る部分)で、 Range("G1").Value = "表示病棟名" →空の列(VLOOKUPが入る部分)で、 Range("H1").Value = "表示商品名" →空の列(VLOOKUPが入る部分)で、 mxR = Range("C" & Rows.Count).End(xlUp).Row Range("A2:A" & mxR).Value = Range("A2") →商品名をコピー Range("B2:B" & mxR).Value = Range("B2") →出庫月をコピー End Sub (Machi) ---- 石鹸のデータ整理は、以下のように実施しています。 Sub 石鹸() Dim mxR As Long Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove →商品名を入れるのに必要な列を追加し、 Range("A5").Value = Range("B2").Value '→元のA2に入力されていた商品名を移し、 Columns("C:C").Copy →元はB列に入力されていた部署名をコピーし、 Columns("F:F").Select →整理に都合が良いF列に可視セルのみコピー「=RIGHT(A7,LEN(A7)-FIND("/",A7))という数式で部署名が入っていたため」 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Rows("1:3").Delete Shift:=xlUp →不要になった1-3行を削除し、 Range("B:D,G:G,I:J,L:M").Delete Shift:=xlToLeft →不要になった列を削除し、 Range("A1").Value = "商品名" →元のA2にあった商品名がA2にのみ入力されている列 Range("B1").Value = "出庫月" →元のD列にあった出庫月が入力されている列 Range("C1").Value = "部署" →元のB列に入っていて、F列に可視セルコピーされた部署名が入力されている列 Range("D1").Value = "出庫数" →元のG列にあった出庫数が入力されている列 Range("E1").Value = "金額" →元のJ列にあった金額が入力されている列 Range("F1").Value = "使用量" →空の列(VLOOKUPが入る列) Range("G1").Value = "表示病棟名" →空の列(VLOOKUPが入る列) Range("H1").Value = "表示商品名" →空の列(VLOOKUPが入る列) mxR = Range("D" & Rows.Count).End(xlUp).Row Range("A2:A" & mxR).Value = Range("A2") →商品名をコピー End Sub (Machi) ---- えっと、、、以降 様式1,2→様式1 様式3→様式2 と書かせてもらいますね。 で、 「様式1」が 石鹸マクロ で、A1セルに [9]SPD の入力があり 「様式2」が 消毒薬マクロ で、A1セルに共通のの入力は無い ですね。 >出庫がなかった場合は、「出庫なし」などの文字がセルのどこかに入力されていますが、 これは 8行目より上の部分に入力されているのでしょうか? 8行目よりも下に入力される事もあるのでしょうか? >それ以外は全く何も入力されていない空シートです。 データの見出し行も無しですか? >元シートからの対応といいますと、以下のような書き方で伝わりますか? すみません、せっかく書いていただきましたが よくわかりません。 ・様式1のどのセルに何が入力されているのか ・様式2のどのセルに何が入力されているのか 一旦コードから離 ...
https://www.excel.studio-kazu.jp/wiki/kazuwiki/201304/20130403114539.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97059 documents and 608315 words.

訪問者:カウンタValid HTML 4.01 Transitional