エクセルの学校：全文検索：Hyper Estraier：日付

Results of 1 - 1 of about 13158 for 日付 (0.003 sec.)

[[20090907110536]]: #score: 2423; @digest: f6ace69b21b54bf24bf978918566b9b8; @id: 45281; @mdate: 2009-09-14T02:06:34Z; @size: 64629; @type: text/plain; #keywords: 服h1 (269939), 許斐 (207916), 胸囲 (100211), 服日 (97477), 斐） (62254), 付3 (57572), 分ル (44768), 付1 (43940), 職員 (33002), mr (25328), 貸出 (24514), 付2 (23277), 員番 (20803), cn (14261), ープ (13754), ルー (12405), book2 (11205), cells (10586), 転記 (10462), value (10022), sheets (9124), プ処 (8848), 日付 (6962), hana (6289), 削除 (6105), sheet1 (5950), 氏名 (5329), workbooks (5169), range (4946), デー (4868), イズ (4748), 番号 (4722); 『複数シートにデータを転記する』（許斐）
職員の制服等貸し出し帳を別シートに転記する方法を教えてください。形が複雑のために、マクロ自動登録できずに困っています。過去検査で転記について調べてみましたが、分かりませんでした。。。。 1.[4]〜[18]行のデータはWorkbooks("book2.xls").Sheets("Sheet2") 2.[20]〜[25]行のデータはWorkbooks("book3.xls").Sheets("Sheet3") Workbooks("book1.xls").Sheets("Sheet1") [A] [B] [C] [D] [E] [F] [G] [H] [I] [J] [K] [L] [M] [4] ふりがなやまだはなこ職員番号 00001 階級 A 所属 B [5] 氏名山田花子生年月日 2009/9/6 採用年月日 2009/9/6 [6] 項目名日付1 日付2 日付3 項目名日付1 日付2 日付3 項目名日付1 日付2 日付3 [7] A服 H1.4.1 H19.10.31 A-1服 H18.12.15 A-2服 H18.12.15 [8] B服 H1.4.1 H19.10.31 B-1服 H1.4.1 B-2服 H1.4.1 [9] C服 H1.4.1 H19.10.31 C-1服 H1.4.1 C-2服 H1.4.1 [10] D服 H1.4.1 H19.10.31 D-1服 H1.4.1 D-2服 H1.4.1 [11] E服 H1.4.1 E-1服 H12.7.21 E-2服 H12.7.21 [12] F服 H1.4.1 F-1服 H18.2.17 F-2服 H18.2.17 [13] G服 H18.3.28 G-1服 H18.10.31 G-2服 H18.10.31 [14] H服 H18.5.26 H-1服 H5.12.24 H-2服 H5.12.24 [15] I服 H9.6.13 I-1服 H1.4.1 H19.10.31 I-2服 H1.4.1 H19.10.31 [16] J服 J-1服 H1.4.1 J-2服 H1.4.1 [17] K服 K-1服 H18.5.26 K-2服 H18.5.26 [18] 備考 L服 [19] [20] サイズ [21] 頭 1 上衣丈 6 キャップ 11 A服 15 [22] 首 2 ウエスト 7 シャツ 12 B服 16 [23] 胸囲 3 尻廻り 8 上着 13 C服 17 [24] 肩幅 4 ズボン丈 9 ズボン 14 D服 18 [25] 袖丈 5 靴 10 上手く説明できているか不安ですが、、よろしくお願いたします。 ---- 4行目から始まる表と20行目から始まる表はかならず4行目と20行目から始まるのですか? もし、決まっているのなら範囲取得はCurrentRegionとかで簡単に取得できると思いますが（momo） ---- 具体的には、こんな感じで範囲は取得できます。 With Columns("A:A") Set r = .ColumnDifferences(.SpecialCells(xlCellTypeBlanks).Cells(1)).Areas For i = 1 To r.Count r.Item(i).CurrentRegion.Select MsgBox i & "つ目の範囲は:" & r.Item(i).CurrentRegion.Address Next i End With （momo） ---- momoさん返信ありがとうございます。 >かならず4行目と20行目から始まるのですか? はいそうです。 CurrentRegionは空欄から空欄のセルの範囲を習得? 下記の表のように転記されませんでした。縦の列を転記終了後に次の項目の列のデータを転記させることは可能でしょか? ("book2.xls").Sheets("Sheet2") のレイアウト [A] [B] [C] [D] [E] [F] [G] [H] [I] [J] [K] [L] [M] [N] [O] [P] [Q] [R] [S] [T] [U] [V] [W] [X] [Y] [Z] [AA] [AB] [AC] [AD] [AE] [AF] [AG] [AH] [AI] [AJ] [AK] [AL] [AM] [AN] [AO] [AP] [AQ] [AR] [AS] [AT] [AU] [AV] [AW] [B] [A] [B] "職員番号" 氏名ふりがな階級生年月日年齢採用年月日 "勤続年数" 所属 A服 B服 C服 D服 E服 F服 G服 H服 I服 J服 K服 A-1服 B-1服 C-1服日付1 日付2 日付3 [2] 00001 山田花子やまだはなこ A 2009/9/6 2009/9/6 B H1.4.1 H19.10.31 H1.4.1 H19.10.31 H1.4.1 H19.10.31 H1.4.1 H19.10.31 H1.4.1 H1.4.1 H18.3.28 H18.5.26 H9.6.13 H18.12.15 H1.4.1 H1.4.1 Workbooks("book3.xls").Sheets("Sheet3") のレイアウト [A] [B] [C] [D] [E] [F] [G] [H] [I] [J] [K] 職員番号氏名ふりがな頭首胸囲肩幅袖丈上衣丈ウエスト尻廻りズボン丈・・・・・・・・・・・・・・・ ---- という事は場所は固定なのですから単純に1つ1つコピーしていくのをマクロ記録を取っても出来ると思いますが >縦の列を転記終了後に次の項目の列のデータを転記させることは可能でしょか? の意味がよくわかりません。あと、データは追加されていくという事ですか? （momo） ---- マトリックス状に入力してあるデータを一行のデータにして転記するって事ですよね? 私なら、Workbooks("book1.xls").Sheets("Sheet1")のデータをどこかにスペースを設けて ("book2.xls").Sheets("Sheet2") のレイアウトの形に参照させておいて ("book2.xls").Sheets("Sheet2") へは、その行をコピペします。すると、マクロにやらせなければ成らない作業（許斐さんがマクロに「こうやってね」って言わなければ成らない事）が減ると思います。 (HANA) ---- momo さん説明不足ですみません＞あと、データは追加されていくという事ですか? はい300人ほどのデータを随時に追加していきます。 (許斐） ---- HANA さん返信ありがとうございます。 >マトリックス状に入力してあるデータを >一行のデータにして転記するって事ですよね? はいそうです。 1.("book2.xls").Sheets("Sheet2") のレイアウト氏名等の情報 + A服〜K服日付1 日付2 日付3 + A-1服〜K-1服日付1 日付2 日付3 + A-2服〜K-2服日付1 日付2 日付3 横一列にデータを転記させます。新データは最終行に追加する。です。 2.("book3.xls").Sheets("Sheet3") のレイアウト職員番号 + 氏名 + ふりがば + 1〜18を横一列横一列にデータを転記させます。新データは最終行に追加する。です。＞私なら、Workbooks("book1.xls").Sheets("Sheet1")のデータを＞どこかにスペースを設けて＞("book2.xls").Sheets("Sheet2") のレイアウト＞の形に参照させておいて ???参照でしょか? 同じ形にデータを並べ替える?ていうことでしょか? （許斐） ---- 小さなデータにして書きますが例えば、Book2の並びが、10行目の様な並びなら [A] [B] [C] [D] [E] [F] [G] [1] 職員番号 1 [2] 氏名山田花子生年月日 2009/9/6 [3] 項目名日付1 項目名日付1 [4] A服 H1.4.1 A-1服 H18.12.15 [5] B服 H1.4.1 B-1服 H1.4.1 [6] [7] [8] [9] [10] 職員番号氏名生年月日 A服 B服 A-1服 B-1服 [11] 1 山田花子 2009/9/6 H1.4.1 H1.4.1 H18.12.15 H1.4.1 [12] ↑=E1 ↑=B2 ↑=IF(B4="","",B4) [13] ↑=IF(B5="","",B5) 11行目の様に、それぞれのセルを参照して、その並びを作っておけば Book2には、11行目のデータを写すだけで良くなります。マクロでの作業を考えたときの大きな流れとしては 1.データ配置の変更 2.転記先の確認 3.転記と言った指示を出すことになると思いますが先に11行の様な行を数式で作っておけば 1番目の作業をマクロで行う必要が無くなりますね。 (HANA) ---- HANA さんなるほどそういうことですね。それも考えましたが、このデータはまだいいんですが、150項目に増える場合は大変なことになりますね。やはりせこせこと地道にやるしかないのですね（T0T) （許斐） ---- これだけ不規則な元データから並び替えるのでしたら、 VBAでコードを書いても数式でのリンクと同じかそれ以上に面倒ですよ。面倒を避けるには集計しやすいように元の個人データを作成しておく事が大切だと思います。私ならユーザーフォームで入力させて、いきなり集計リストにするか LAN環境だけで出来るのであれば、HTAなんかでブラウザから入力させてしまいます。（momo） ---- 全部をマクロがやる様なコードを作るのと一部数式も使用しながらコードをを作るのと今まで通り手作業で転記するのとどれが早いかって事じゃないでしょうか。コードだって「こんな風に動くコードよ、出来ろ!!」と念じるだけでは出来ません。自分がやることなら決め打ちで非常にテキトーなコードを作りますが。地道にやるにしても 11行目の様なデータが有るか無いかは作業に大きな差が出ると思います。サンプルとして、エラー処理無しの決め打ちコードを載せておきます。 Sub 貸し出し() Dim mr As Long If ActiveWorkbook.Name = "Book2.xls" Or _ ActiveWorkbook.Name = "Book3.xls" Then MsgBox "ブックが違います。" Exit Sub End If With Workbooks("Book2.xls").Sheets("Sheet2") mr = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Cells(mr, 1).Value = Sheets("Sheet1").Range("E1").Value '職員番号 .Cells(mr, 2).Value = Sheets("Sheet1").Range("B2").Value '氏名 .Cells(mr, 3).Value = Sheets("Sheet1").Range("E2").Value '生年月日 .Cells(mr, 4).Value = Sheets("Sheet1").Range("B4").Value 'A服 .Cells(mr, 5).Value = Sheets("Sheet1").Range("B5").Value 'B服 .Cells(mr, 6).Value = Sheets("Sheet1").Range("E4").Value 'A-1服 .Cells(mr, 7).Value = Sheets("Sheet1").Range("E5").Value 'B-1服 End With End Sub Sub サイズ() Dim mr As Long If ActiveWorkbook.Name = "Book2.xls" Or _ ActiveWorkbook.Name = "Book3.xls" Then MsgBox "ブックが違います。" Exit Sub End If With Workbooks("Book3.xls").Sheets("Sheet3") mr = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Cells(mr, 1).Value = Sheets("Sheet1").Range("E1").Value '職員番号 .Cells(mr, 2).Value = Sheets("Sheet1").Range("B2").Value '氏名 .Cells(mr, 3).Value = Sheets("Sheet1").Range("E2").Value '生年月日 .Cells(mr, 4).Value = Sheets("Sheet1").Range("B11").Value '頭 .Cells(mr, 5).Value = Sheets("Sheet1").Range("B12").Value '首 .Cells(mr, 6).Value = Sheets("Sheet1").Range("B13").Value '胸囲 .Cells(mr, 7).Value = Sheets("Sheet1").Range("D11").Value '上衣丈 .Cells(mr, 8).Value = Sheets("Sheet1").Range("D12").Value 'ウエスト .Cells(mr, 9).Value = Sheets("Sheet1").Range("D13").Value '尻廻り End With End Sub Sub 両方() Call 貸し出し Call サイズ End Sub 以下の環境を整えて試して下さい。 Book1.xlsのSheet1 [A] [B] [C] [D] [E] [1] 職員番号 1 [2] 氏名山田花子生年月日 2009/9/6 [3] 項目名日付1 項目名日付1 [4] A服 H1.4.1 A-1服 H18.12.15 [5] B服 H1.4.1 B-1服 H1.4.1 [6] [7] [8] [9] [10] サイズ [11] 頭 1 上衣丈 6 [12] 首 2 ウエスト 7 [13] 胸囲 3 尻廻り 8 Book2.xlsのSheet2 [A] [B] [C] [D] [E] [F] [G] [1] 職員番号氏名生年月日 A服 B服 A-1服 B-1服 [2] [3] Book3.xslのSheet3 [A] [B] [C] [D] [E] [F] [G] [H] [I] [1] 職員番号氏名生年月日頭首胸囲上衣丈ウエスト尻廻り [2] [3] 3つのブックを開き Book1をアクティブにした状態で実行します。コードは、4つ目のブックを新規作成しそこへ置いておくのが良いかもしれません。また、マクロでやらせるなら転記日もどこかに書く様にしておくのが良いのではないかと思います。ループ処理などを入れるとコードも短くなるかもしれませんが開発に時間も掛けられないならこの程度の物でも、一度作ってしまえば無いよりは有る方がマシ? この様な作りにするなら＞150項目に増える場合は大変なことになりますね。は、いずれにしても大変なのに代わりはないですね。 (HANA) ---- momo さんフォームが複雑のため、マクロでは難しいですね。いろいろ調べたところ、配列を定義するとできるかも、までは掴んだんですが、いまいち何かが足りない。（たんなる考えが甘いだけかも、、、）勉強不足ですね。（許斐） ---- あ、衝突しちゃったけどそのままのせとこ。ループ処理などを入れるとってのも例えば .Cells(mr, 4).Value = Sheets("Sheet1").Range("B11").Value '頭 .Cells(mr, 5).Value = Sheets("Sheet1").Range("B12").Value '首 .Cells(mr, 6).Value = Sheets("Sheet1").Range("B13").Value '胸囲 .Cells(mr, 7).Value = Sheets("Sheet1").Range("D11").Value '上衣丈 .Cells(mr, 8).Value = Sheets("Sheet1").Range("D12").Value 'ウエスト .Cells(mr, 9).Value = Sheets("Sheet1").Range("D13").Value '尻廻りこんな所はここだけを取り出してテキトウに For i = 1 To 3 '頭,首,胸囲 .Cells(mr, i + 3).Value = Sheets("Sheet1").Range("B" & i + 10).Value Next For i = 1 To 3 '上衣丈,ウエスト,尻廻り .Cells(mr, i + 6).Value = Sheets("Sheet1").Range("D" & i + 10).Value Next なんて、事をするのもあり? それにしても、左側が Cells で、右側が Range なんて。。。 (HANA) ---- HANA さん返信ありがとうございます。光がまた一つ見えるように思います。＞ループ処理などを入れるとコードも短くなるかもしれませんが＞開発に時間も掛けられないなら＞この程度の物でも、一度作ってしまえば無いよりは有る方がマシ? 期限は今月中なので少し余裕があります。サイズは何とかできそうですが、服のほうが難しそうですね。ループと配列のほうも少し調べてみます。（許斐） ---- HANA さんなんとなくこんな感じです。＞For i = 1 To 3 '頭,首,胸囲 >なんて、事をするのもあり? 正常に動けばなんでもあり（笑 (許斐） ---- 配列でもRangeオブジェクトの直接参照でも処理的には大差ないです。時間の差程度です。氏名とかひらがななんかを見ると順番に並んでいないので、面倒な事に変わりは無いですよね。私が考えたコードもHANAさんのと殆ど同じコードでした。ユーザーフォームが使えると、とても綺麗に簡単に作れますので次のこのような作業の前までに勉強されてみると良いかもしれません。（momo） ---- 何をどの様に処理することを考えておられるのかわかりませんが一つのブックずつ処理をする（配置変換&転記をする）事を考えておられるなら momoさんも書いておられるように配列を使っても画期的に処理スピードが短くなることはないと思います。また、ループ処理でコードを書いても処理スピードがあがるわけではありません。数式で配置換えを考えた時＞150項目に増える場合は大変なことになりますね。という部分を重く見るのなら配列の勉強よりも、ループ処理の勉強をなさった方が良いのではないかと思います。また、私がのせたサンプルコードではセル番地が分かりやすいようデータ元のセルを Rangeを使用して書きました。これを、Cellsの形に変更して書いてみるとどこをどのようにループさせればよいのか分かりやすくなるかもしれませんし配列を使用したコードにする際も、考えやすくなると思います。＞期限は今月中なので少し余裕があります。でしたら、まずは Cells(行番号,列番号) 列はアルファベットではなく数で指定する書き方で、コードを完成させてみるのが良いかもしれません。服の方は、A列の処理（A服〜K服の処理）を考えた時転記先もA服〜K服の順になっているなら行方向へループさせるうちに列方向へのループを入れれば良い事が分かると思います。 (HANA) ---- momoさん返信ありがとうございます。ユーザフォームはExcelに付属のメニュー → データ → フォームでしたら、一番に確かめましたが容量が多いためできませんでした。 (許斐) ---- HANAさんありがとうございます。まだ検証していませんが、これをもとに明日チャレンジしてみます。 (許斐) ---- >メニュー → データ → フォームではなくて、VBAのユーザーフォームです。これを使えるようになれば、入力は単独で入力しやすいユーザーインターフェースを用意する事ができて、さらにデータはリスト型式のデーターベースとして保存する。という事が一連の作業の中でユーザーに意識させる事なく完成させられます。（momo） ---- momo さん >VBAのユーザーフォームこれははじめて知りました。アクセスに似ていますね。これにすることにより VBAコードで設定しなくてOKになるんでしょか? 登録は見つけましたが、修正や検索などもできるのでしょか? （許斐） ---- HANA さん早速検証してみました。＞If ActiveWorkbook.Name = "Book2.xls" Or _ ＞ ActiveWorkbook.Name = "Book3.xls" Then ＞ MsgBox "ブックが違います。" ＞ Exit Sub これはシートを判別するものでしょか? シートがあるかないかみたいな??? ＞With Workbooks("Book2.xls").Sheets("Sheet2") ＞mr = .Range("A" & Rows.Count).End(xlUp).Row + 1 ＞ .Cells(mr, 1).Value = Sheets("Sheet1").Range("E1").Value '職員番号これはシート2A列の最終行を取得しE1の値を格納する。と分かりましたが、＞For i = 1 To 3 '頭,首,胸囲＞ .Cells(mr, i + 3).Value = Sheets("Sheet1").Range("B" & i + 10).Value 3行を3列に格納 ^^^^^ ではこれなぜ10?? ^^^^^^^ （許斐） ---- ＞これはシートを判別するものでしょか? ＞シートがあるかないかみたいな??? シート名ではなく、ブック名を判定しています。前提として Book1（データの有るブック）と Book2,Book3 が開いている状態です。そして、コードは【アクティブブックの】Sheet1のデータを Book2とBook3にそれぞれ転記するコードです。（データの有るブック名は個人名がつけられている等固定でないと思ったので、ブック名を特定する処理ではなく【アクティブブック】と言う認識をさせています。ブック名が固定なら If ActiveWorkbook.Name <> "Book1.xls" Then とかで良いですね。）アクティブブックが、Book1で無い場合つまり、データの有るブックとは違うブックだった場合そのデータ（意図しないデータ）がBook2とBook3に転記されてしまいます。それを避ける為に、事前にブック名を確認したいのですが私は「データの有るブック名は固定ではない」と思っています。データブックが一つ、転記先ブックが二つ開いている状態でアクティブブック名が、二つの転記先ブック名と違えば消去法で、データブックがアクティブに成っていると考えその様なコードにしてあります。 ◆ ＞シート2A列の最終行を取得しE1の値を格納する。なんだか、あれやらこれやらごっちゃに書いて居られます? 変数mr に Book2のSheet2のA列の入力がある最終行の行番号+1 を格納（メモ）し Book2のSheet2の mrの行で1列目のセルにアクティブブックのSheet1のE1セルの値を入れます。まとめて書くと、書いて居られるような処理に成るかな? （ちょっとイメージが違うんじゃないかと言う印象は受けますが。） ◆ ＞ 3行を3列に格納 ^^^^^ ではこれなぜ10?? ^^^^^^^ 今回使用している変数は、mr と i です。 Cellsはセル番地を表します。 Cells(行番号,列番号)の様に書き、例えば、C2セルは Cells(2 , 4) です。＞ .Cells(mr, 4).Value = Sheets("Sheet1").Range("B11").Value '頭このコードは、変数mr が「2」だった場合 C2セルにSheet1のB11セルの値を書き込みます。以下＞ .Cells(mr, 5).Value = Sheets("Sheet1").Range("B12").Value '首＞ .Cells(mr, 6).Value = Sheets("Sheet1").Range("B13").Value '胸囲 D2セルにSheet1のB12セルの値 E2セルにSheet1のB13セルの値を書き込みます。＞ For i = 1 To 3 '頭,首,胸囲＞ .Cells(mr, i + 3).Value = Sheets("Sheet1").Range("B" & i + 10).Value ＞ Next このコードは、変数mr が「2」の時ループ処理の一回目（i = 1）では .Cells(mr, 1 + 3).Value = Sheets("Sheet1").Range("B" & 1 + 10).Value ↓ .Cells(mr, 4).Value = Sheets("Sheet1").Range("B" & 11).Value ↓ .Cells(mr, 4).Value = Sheets("Sheet1").Range("B11").Value C2セルに、Sheet1のB11セルの値を書き込みます。ループ処理の二回目（i = 2）では .Cells(mr, 2 + 3).Value = Sheets("Sheet1").Range("B" & 2 + 10).Value ↓ .Cells(mr, 5).Value = Sheets("Sheet1").Range("B" & 12).Value ↓ .Cells(mr, 5).Value = Sheets("Sheet1").Range("B12").Value D2セルに、Sheet1のB12セルの値を書き込みます。ループ処理の三回目（i = 3）では .Cells(mr, 3 + 3).Value = Sheets("Sheet1").Range("B" & 3 + 10).Value ↓ .Cells(mr, 6).Value = Sheets("Sheet1").Range("B" & 13).Value ↓ .Cells(mr, 6).Value = Sheets("Sheet1").Range("B13").Value E2セルに、Sheet1のB13セルの値を書き込みます。 ◆ 因みに、最初にも書いていますように「違うブックがアクティブになっていたら。。。」程度は考えていますが「Book2やBook3が開いて居なかったら?」や「それぞれのシートがブックに存在しなかったら?」なんてエラー処理は考えていません。 (HANA) ---- HANA さんありがとうございます。やっと理解できました。＞.Cells(mr, i + 3).Value = Sheets("Sheet1").").Range("B" & i + 10).Value ^^^^^^^^^ は勘違いしていました。 Cells（行,列）と同じく ("B" & i + 10)もB列から+10列(K列）だと勘違いしていました（^^;;; （許斐） ---- HANA さんまだ一つですが、思い通りの結果得ることができました。（といっても^^;;ほとんどHANAさんの書いたコードを使っただけですが。。。） Sub サイズ() Dim mr As Long Dim MaxRows As Long If ActiveWorkbook.Name <> "Book1.xls" Then Exit Sub End If With Workbooks("Book3.xls").Sheets("Sheet2") mr = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Cells(mr, 1).Value = Sheets("Sheet1").Range("E4").Value '職員番号 .Cells(mr, 2).Value = Sheets("Sheet1").Range("B5").Value '氏名 .Cells(mr, 3).Value = Sheets("Sheet1").Range("B4").Value 'ふりがな For i = 1 To 5 '頭,首,胸囲 .Cells(mr, i + 3).Value = Sheets("Sheet1").Range("B" & i + 20).Value .Cells(mr, i + 8).Value = Sheets("Sheet1").Range("D" & i + 20).Value Next For i = 1 To 4 'キャップ,シャツ,上着,ズボン .Cells(mr, i + 13).Value = Sheets("Sheet1").Range("F" & i + 20).Value .Cells(mr, i + 17).Value = Sheets("Sheet1").Range("H" & i + 20).Value Next End With End Sub For i = 1 To 5 '頭,首,胸囲 ^^^を最後の行を認識できたらもう少しコンパクトになりますね。 MAxrowsで試したんですが、だめでした。違うのでしょか?? （許斐） ---- まず、コードに関してですが。。。変数i の宣言もしておいてあげてください。それから、例えば For i = 1 To 5 '頭,首,胸囲 .Cells(mr, i + 3).Value = Sheets("Sheet1").Range("B" & i + 20).Value .Cells(mr, i + 8).Value = Sheets("Sheet1").Range("D" & i + 20).Value Next For i = 1 To 4 'キャップ,シャツ,上着,ズボン .Cells(mr, i + 13).Value = Sheets("Sheet1").Range("F" & i + 20).Value .Cells(mr, i + 17).Value = Sheets("Sheet1").Range("H" & i + 20).Value Next この部分は For i = 1 To 4 '頭,首,胸囲'キャップ,シャツ,上着,ズボン .Cells(mr, i + 3).Value = Sheets("Sheet1").Range("B" & i + 20).Value .Cells(mr, i + 8).Value = Sheets("Sheet1").Range("D" & i + 20).Value .Cells(mr, i + 13).Value = Sheets("Sheet1").Range("F" & i + 20).Value .Cells(mr, i + 17).Value = Sheets("Sheet1").Range("H" & i + 20).Value Next '↓'頭,首,胸囲の i=5 は一回なので個別に .Cells(mr, 8).Value = Sheets("Sheet1").Range("B25").Value .Cells(mr, 13).Value = Sheets("Sheet1").Range("D25").Value の様に i = 1 To 4 でまとめても良いかもですね? あと、確認ですが＞If ActiveWorkbook.Name <> "Book1.xls" Then として居られると言う事は、ブック名が固定ですか? これは、一つのブックを使ってデータを入力後転記。同じブックのデータを削除して、次の人のデータを入力し転記。と言う使用方法ですか? （つまり、テンプレートの様な使用方法）それとも、それぞれの人に関して同じ名前のブックが複数存在するという事でしょうか? さて、ご質問に関してですが。。。＞^^^を最後の行を認識できたらもう少しコンパクトになりますね。これの意味がよく分かりません。入力のある範囲は、事前に決まっているのかと思っていましたが? それから、どの様に書けてコンパクトに成ると思われたのかイメージを教えていただければと思います。 (HANA) ---- HANA さん＞これは、一つのブックを使ってデータを入力後転記。入力フォーム（bookは）一つだけです。＞入力のある範囲は、事前に決まっているのかと思っていましたが? 今は決まっています。今後制服の種類が増えても対応できたらと思っただけです。 >イメージを教えていただければと思います。 If A列（項目名）<> "" Then A列の項目名が空欄じゃないとき。B列の値を転記みないな???（なんとなくイメージです）空欄の時はD列行って同じく処理するみたいな? iの変数を追加しました。（許斐） ---- ＞入力フォーム（bookは）一つだけです。でしたら、マクロ実行ボタンをBook1のSheet1に置くことにしてそこからしか実行しない状況にしておけば If ActiveWorkbook.Name <> "Book1.xls" Then の確認や、転記部分の .Cells(mr, i + 3).Value = Sheets("Sheet1").Range("B" & i + 20).Value ここにシート名を入れて限定していますが/‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ この部分も無くして仕舞っても良さそうですね。 ◆ ＞A列の項目名が空欄じゃないとき。B列の値を転記みないな???（なんとなくイメージです）良く分かります。そんなときは、For〜でループさせるのではなく Do〜でループさせる事が多いと思います。ただ、その運用で本当に大丈夫でしょうか? 今後制服の種類が増えた場合は、転記前に Book2やBook3の列も移動させないといけないんですよね? 移動させる前に気づかずにコードを実行してしまうと 1行目の項目とは違う項目のデータが気づかない内に各セルに入ることに成ると思いますが。。。種類を増やした時にコードを変更するのを忘れて転記されないのと転記先のブックの項目を変更するのを忘れて変な所へ転記されるのと。。。キュウキョクノセンタク? ＞入力フォーム（bookは）一つだけです。って事なんで、転記後はマクロでデータを削除して仕舞えば次に入力するときに「あれ?データが残ってるんだけど。。。そうだ!!ここは項目を増やしたんだった!!」と、コード他変更する必要が有ることに気づけるかもしれません。今回は、この程度に留めておくのが安全に思いますが。 (HANA) ---- HANA さんそんなトラップが、、、分かりました。サイズはこのまま使用します。貸し出しについてですが、 [A] [B] [C] [D] 項目名日付1 日付2 日付3 [7] A服 1 12 23 [8] B服 2 13 24 [9] C服 3 14 25 [10] D服 4 15 26 [11] E服 5 16 27 [12] F服 6 17 28 [13] G服 7 18 29 [14] H服 8 19 30 [15] I服 9 20 31 [16] J服 10 21 32 [17] K服 11 22 33 ↓転記後表示したい結果 A服日付1 A服日付2 A服日付3 B服日付1 B服日付2 B服日付3 C服日付1 C服日付2 C服日付3 ・・・・・・・・・ 1 12 23 2 13 24 3 14 25 チャレンジしたループ（失敗に終わりました。） For ii = 1 To 3 '日付1&日付2&日付3のつもり For i = ii To 11 'A服〜K服 .Cells(mr, i + 9).Value = Sheets("Sheet1").Range("B" & i + 6).Value .Cells(mr, i + 20).Value = Sheets("Sheet1").Range("F" & i + 6).Value Next Next どうしたら、表示させたい結果になるか教えてください。（許斐） ---- 現在チャレンジして居られる事は、少し難しいです。まず、右側を考えてみます。例えば、B7:D7の転記を考えたときループの度に Sheet1のB7セル→Sheet1のC7セル→Sheet1のD7セルとやっていこうと思うならこれは列が移動しますので Sheets("Sheet1").Range("B" & i + 6).Value ここが/‾‾‾‾「B」で固定に成ってるのはおかしいですね。こちらも、Cells(行,列)の形で書いてみられてはどうでしょう。或いは、三つは続けて書く? .Cells(mr, i + 9).Value = Sheets("Sheet1").Range("B" & i + 6).Value .Cells(mr, i + 10).Value = Sheets("Sheet1").Range("C" & i + 6).Value .Cells(mr, i + 11).Value = Sheets("Sheet1").Range("D" & i + 6).Value こんな感じで。すると、行方向へのループだけで良いことに成りますね。次に、左側を考えると。。。今回は、今までみたいに単純に iに足し算するだけでは列の数が合わないですね。二重のループを考えるなら一つセルを参照するたびに、書き出す列番号が一つ増えます。三つ続けて書いた場合は、 i が 1 の時は 1 i が 2 の時は 4 i が 3 の時は 7 って感じで増えていきますね。一つループが終わるたびに +3 ずつ増える。いずれにしても、左側の列をカウントする変数を追加で用意するのが良さそうに思います。まずは、右側を Cellsにしてループの中にループを入れるかそれとも、Rangeのまま3行書いて、ループを一つでするかお好きな方を選んで、方針を決めて頂ければと思います。 (HANA) ---- HANA さんすみませんあまり理解しきれていないのですが、ループは横の列か縦の列どちかにする、ていうことでしょか? 参考するなにかありましたら、助かります。（許斐） ---- えっと、どの様にでも書けるので先にそれを決めなきゃいけないって感じです。どの様にループさせるかによって書き出す列番号を決めていく方法が変わります。 A1から始まる簡単なサンプルコードを書いておきます。 [A] [B] [C] [D] [1] 項目名日付1 日付2 日付3 [2] A服 1 12 23 [3] B服 2 13 24 [4] C服 3 14 25 [5] D服 4 15 26 [6] [7] [8] [9] A服 B服 C服 D服 [10] 日付1 日付2 日付3 日付1 日付2 日付3 日付1 日付2 日付3 日付1 日付2 日付3 [11] [12] まずは二重のループにして、書き出す列番号を一つずつ増やす。 Sub ふたつで() Dim i As Long, ii As Long, cn As Long For i = 1 To 4 'A服〜D服の4行分ループ For ii = 1 To 3 '日付1〜日付3の3列分ループ cn = cn + 1 Cells(11, cn).Value = Cells(i + 1, ii + 1).Value Next Next End Sub i = 1 の時、ii = 1 〜 3 の処理が行われ、次に i = 2 の時、ii = 1 〜 3 の処理が行われ・・・・って感じで進んでいきます。ループは一つにして、書き出す列番号を+3 ずつふやす。 Sub ひとつで() Dim i As Long, cn As Long For i = 1 To 4 'A服〜D服の4行分ループ Cells(12, cn + 1).Value = Range("B" & i + 1).Value Cells(12, cn + 2).Value = Range("C" & i + 1).Value Cells(12, cn + 3).Value = Range("D" & i + 1).Value cn = cn + 3 Next End Sub 因みに、変数は初期状態で 0 です。 (HANA) ---- HANA さんありがとうございます。ループについて理解しました。早速試してみました。二重フープは難しいですね。やっとなんとなく理解できました。質問です。私の二番目のループは何が違うのでしょか@とAは転記してくれませんでした。 Sub 貸出入力() Dim mr As Long Dim i As Long, cn As Long If ActiveWorkbook.Name <> "Book1.xls" Then Exit Sub End If With Workbooks("Book2.xls").Sheets("Sheet1") mr = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Cells(mr, 1).Value = Range("E4").Value '職員番号 .Cells(mr, 2).Value = Range("B5").Value '氏名 .Cells(mr, 3).Value = Range("B4").Value 'ふりがな .Cells(mr, 4).Value = Range("E5").Value '生年月日 .Cells(mr, 6).Value = Range("H5").Value '採用年月日 .Cells(mr, 8).Value = Range("H4").Value '階級 .Cells(mr, 9).Value = Range("J4").Value '所属 For i = 6 To 16 'A服〜D服の4行分ループ i = 0 For ii = 1 To 3 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn + 9) = Cells(i + 1, ii + 1).Value .Cells(mr, cn + 45) = Cells(i + 1, ii + 5).Value .Cells(mr, cn + 81) = Cells(i + 1, ii + 9).Value Next Next For ii = 1 To 3 '日付1〜日付3の3列分ループ cn = cn + 1 '@ .Cells(mr, cn + 42) = Cells(18, ii + 1).Value '問題ありません .Cells(mr, 115).Value = Range("F18").Value '備考 'A .Cells(mr, cn + 112) = Cells(18, ii + 9).Value Next End With End Sub (許斐） ---- 思ったセルと違うセルを転記している（入力が無いセルで、転記されて居ない様に思える。）思ったセルと違うセルへ転記している（違うセルを見ているので、転記されて居ない様に思える。）なんて事は無いですか? '@の所は ii=1 の時 B18セルを BX列に ii=2 の時 C18セルを BY列に ii=3 の時 D18セルを BZ列に転記しています。下側の For ii = 1 To 3 '日付1〜日付3の3列分ループの行にブレークポイントを設定して、ステップインで実行しながら、cnの値がどうなっているのか確認してみてください。ブレークポイントは、コードの左側の灰色の部分をクリックすると茶色い●が表示され、設定出来ます。コードを実行すると、その場所で一端とまりますので [ F8 ]キーを押しながら一行ずつ実行させてください。（黄色いハイライトの行が一つずつ下がっていきます。） cnの値は、cnの上にマウスを持っていって少し待つと表示されます。うまくいかない場合は、VBEメニューの表示(V)からローカルウィンドウを表示させて、そちらで確認してみてください。 (HANA) ---- HANA さんありがとうございます。あまり理解はしていないのですが、 @ .Cells(mr, cn + 9) = Cells(18, ii + 1).Value にしたところ↓思い通りの結果になりました。 ii=1 の時 B18セルを CA列に ii=2 の時 C18セルを CB列に ii=3 の時 D18セルを CC列に一つ疑問ですが、 AFor i = 6 To 16 'A服〜D服の4行分ループ i = 0 For ii = 1 To 3 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn + 9) = Cells(i + 1, ii + 1).Value cn+9が同じなのに問題ないのですねなぜ? A の処理の後にまた9列目のにもだって@の処理をするのでしょか? ダブらないのは不思議です。?? (許斐） ---- 難しいですね。 cnの値がどのように移り変わっているのか分かりますか? 前半部分も一行ずつ実行して確認していくと＞cn+9が同じなのに問題ないのですねなぜ? ＞A の処理の後にまた9列目のにもだって@の処理をするのでしょか? ＞ダブらないのは不思議です。?? この辺りの疑問も解けるかもしれません。また、適当にやって数が合ったのならやはり＞＞ステップインで実行しながら、cnの値がどうなっているのか＞＞確認してみてください。この様な作業で、自分で書いたコードが実際にどの様に動いて居るのかまた、その時の変数の値などを確認出来る様になると思った通りに疑問無く動くコードをより短時間で作成出来るようになると思います。 (HANA) ---- HANA さん一度に処理されているわけではなく forで設定させた行数を処理終わるまで1行ずつ?行ったりきたりしていますね。なるほどでです。勘違いしていました。本当にありがとうございます。お陰様で転記は無事に終わりました。感謝 ×100 (許斐） PS・指定された職員番号の行ごと削除はできましたが、検索と内容修正はチャレンジしてみようと思います。今作っているコードを逆にしたできるかな〜と思いましたが、甘いでしょか（汗 ---- ＞一度に処理されているわけではなく＞forで設定させた行数を処理終わるまで1行ずつ?行ったりきたりしていますねそうです。下側のループで、列がずれた理由も分かりましたか? もう少し、転記部分のコードについて続けさせてください。＞変数i の宣言もしておいてあげてください。と言う書き込みをした後に＞それから、例えば＞・・・（中略）・・・＞この部分は＞・・・（中略）・・・＞の様に i = 1 To 4 でまとめても良いかもですね? と書きました。確かにすっきりするかもしれませんが、この様にしてしまうと「この列は項目が一つ増えた」なんて時に修正が大変ですよね? そういったことを考えると、前言を撤回してまとめない方が良い様に思います。そして、順番に転記されて行くようなコードにしておくのが良いかもしれません。たとえば For i = 6 To 16 'A服〜D服の4行分ループ i = 0 For ii = 1 To 3 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn + 9) = Cells(i + 1, ii + 1).Value .Cells(mr, cn + 45) = Cells(i + 1, ii + 5).Value .Cells(mr, cn + 81) = Cells(i + 1, ii + 9).Value Next Next この部分は一度のループで 10,16,82列のセルにデータが入りますね。もしも、項目が増えた場合 +45はいくつになれば良いの? +81はいくつになれば良いの? と、よく分かりません。単調なコードになってしまいますがあとで修正する事を考えると一つのまとまり毎に書いておいた方が良さそうに思います。データは、左から順に隙間無く埋まっていくと思いますのでループの中身は .Cells(mr, cn + 9).Value = Cells(i , ii).Value で固定にして、i と ii の開始と終わりをまとまり毎に変更する。・・・・意味が分かりますか? (HANA) ---- HANA さんループ処理をまとめるではなく、一回のブロックに一つのループを設定することにより修正等あるとき一目で分かりやすいて言うことですね。 For i = 6 To 16 'A服〜D服の4行分ループ i = 0 For ii = 1 To 3 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn + 9) = Cells(i + 1, ii + 1).Value .Cells(mr, cn + 45) = Cells(i + 1, ii + 5).Value .Cells(mr, cn + 81) = Cells(i + 1, ii + 9).Value Next Next ↑を ↓ For i = 7 To 18 'A服〜D服の4行分ループ i = 1 For ii = 2 To 4 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn + 9) = Cells(i, ii).Value Next Next For i = 7 To 17 'A服〜D服の4行分ループ i = 1 For ii = 6 To 8 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn + 9) = Cells(i, ii).Value Next Next For i = 7 To 18 'A服〜D服の4行分ループ i = 1 For ii = 10 To 12 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn + 9) = Cells(i, ii).Value Next Next にする? （許斐） ---- そうです!! （伝わって良かった。。。）そうしておくと、転記元のセル番地を見ながら i と ii に番号を写し取るだけですむんじゃないかと思います。どちらがより良いかは、許斐さんの判断にお任せします。それから、今は Cellsの中で cn+9 ってしてますね。それは .Cells(mr, 9).Value = Range("J4").Value '所属ここまでの間に 9列分はすでに入力済みだからですよね。そこで、ループ処理を始める前に cn = 9 と値を入れておけばループが始まった最初は cn = 9 + 1 = 10 ってなるので .Cells(mr, cn + 9) = Cells(i, ii).Value ここのところの +9 が/‾‾‾‾ それぞれ要らなくなると思います。後は、このマクロはBook1のSheet1にマクロ実行ボタンを作ってそこから実行するのでしょうから If ActiveWorkbook.Name <> "Book1.xls" Then Exit Sub End If も不要になりますよね? それと、おまじない的な事になるかもしれませんが .Cells(mr, cn + 9).Value = Cells(i, ii).Value ‾‾‾‾‾‾‾これもつけておかれるのが良いと思います。細かい所だと、行方向のループのコメントが全部「'A服〜D服の4行分ループ i = 1」ってなってますね。。。項目名が何かの順になってないなら列番号を入れるなどどの部分に関する処理をしているのか、分かるように書いておかれるのが宜しいかと思います。ちなみに＞＞転記後はマクロでデータを削除して仕舞えばこの部分は付け加えましたか? (HANA) ---- HANA さん＞どちらがより良いかは、許斐さんの判断にお任せします。言われたとおりに直しましたら列数を計算せずともわかるようになりました。段落ごとのループを使用したいと思います。ループはまとめ過ぎると後々が不憫になりますね。勉強になりました。＞下側のループで、列がずれた理由も分かりましたか? シートの列番号をそのまま入れたからです。 >ここまでの間に 9列分はすでに入力済みだからですよね。はい。それは分かりました。変数ii忘れてました^^;; >ループ処理を始める前に cn = 9 cn = 9 For i = 7 To 18 'A服〜D服の4行分ループ i = 1 For ii = 2 To 4 '日付1〜日付3の3列分ループ cn = cn + 1 .Cells(mr, cn).Value = Cells(i, ii).Value 省略-------------------------------- .Cells(mr, 115).Value = Range("F18").Value '備考 End With ↑こんな感じですか? ＞＞転記後はマクロでデータを削除して仕舞えば転記してから値をクリアさせると親切ですねえ〜とちょっと横のループにチャレンジ（あまり必要性がないかも^^;;）（許斐） ---- ＞ループはまとめ過ぎると後々が不憫になりますね。そうですね。まとめかたにもよると思いますが。。。まとめれば良いってものでも無いと思いますので。状況にもよりますよね。タブン。＞シートの列番号をそのまま入れたからです。あ、そうだったんですか。ループが終わると cnがリセットされる様な印象をもっておられたのかと思いましたが。。＞こんな感じですか? そんな感じです。＞転記してから値をクリアさせると親切ですねというか、まぁ親切ですがあのときも書いた様に「うっかりコードを変更してなくて転記されなかった時に気づくように」って意味もあります。たとえそれを入れていても削除する方だけなおして実際に転記する部分を直さないなんて中途半端になおしたのでは何の足しにもならないのですが。＞ちょっと横のループにチャレンジはい、チャレンジしてください。ただし、実際はセルをまとめて指定して削除する事にした方が良いんじゃないかと思います。セルへの処理は時間がかかりますので。たとえば、 Range("B4:B5,E4:E5,H4:H5,J4").ClearContents で、該当の7セルの内容を削除出来ます。あ、今気づきましたが「貸し出し」の転記と「サイズ」の転記を別コードにするなら共通部分のデータをどの段階で消せば良いのかは考えないといけないですね。どちらも同時に実行すれば良いのかな? でしたら、全部済んだ後に消せば良さそうですが。 (HANA) ---- HANA さんすごく簡単なの作ってみました。クリアはこれしか知らない私である。（涙;; Sub 値のみクリア() '氏名等 Range("B5,B4,E5,E4,H5,H4,J4,F18").Select Selection.ClearContents '貸し出し Range("B7:D18,F7:H18,J7:L18").Select Selection.ClearContents 'サイズ Range("B21:B25,D21:D25,F21:F24,H21:H24").Select Selection.ClearContents End Sub あれ?↓短縮できたんですね^^;; Sub 値をクリア() '氏名等 Range("B5,B4,E5,E4,H5,H4,J4,F18").ClearContents '貸し出し Range("B7:D18,F7:H18,J7:L18").ClearContents 'サイズ Range("B21:B25,D21:D25,F21:F24,H21:H24").ClearContents End Sub ＞「うっかりコードを変更してなくて転記されなかった時に気づくように」で思い出しました。職員番号ダブりをなくしたいです。転記する前にチェックさせることできますか? （許斐） ---- ＞クリアはこれしか知らないいや、それしかないかと。。。＞あれ?↓短縮できたんですねマクロの記録で得られるコードは △△.Select Selection.×× となりますが、コードを書く際は Selectしないコードを心がけるのが良いと思います。マクロの記録をご活用でしたら △△.Select Selection.×× をみたら、 △△.×× の形になおしてみるのが良いと思います。＞転記する前にチェックさせることできますか? COUNTIF関数で調べましょう。＞検索と内容修正はチャレンジしてみようと思います。を見据えるなら、MATCH関数の方が良いかな? ＞指定された職員番号の行ごと削除はできましたがこれはどのようにやったのでしょう? (HANA) ---- HANA さん＞マクロの記録をご活用でしたらそうなんですか?なるほどそのようにします。＞MATCH関数そうなんですか??VBAの関数?普通の関数? ＞検索と内容修正はチャレンジしてみようと思います。 1/4はものまねで、無駄が多いですがこんな感じです。 Public Sub 削除_Click() Dim kt Dim k Dim wb(1 To 2) As Worksheet Dim WS Dim i As Long Dim res As Long k = Workbooks("book1.xls").Worksheets("sheet1").Range("B5").Value kt = Workbooks("book1.xls").Worksheets("sheet1").Range("E4").Value Set wkSheets(1) = Workbooks("book2.xls").Worksheets("sheet1") Set wkSheets(2) = Workbooks("book3.xls").Worksheets("sheet2") res = MsgBox(k & "のデータを削除しますか? ", vbYesNoCancel) If res = vbCancel Then Cancel = True MsgBox "キャンセルします。" Else For Each WS In wb With WS For i = .Cells(WS.Rows.Count, 1).End(xlUp).Row To 1 Step -1 If .Cells(i, 1).Value = kt Then .Rows(i).Delete End If Next End With Next MsgBox "削除しました。" End If End Sub （許斐） ---- 一つずつ見ていく方式ですね。でしたら、ループが全部終わっても If .Cells(i, 1).Value = kt Then の次の行へ行かなかったら、データが無かった事が分かりますね。 Then 〜 End If の間に今は Rows(i).Delete をしていますがたとえば fr = i とかでセルの値が一致したら、その行を fr って変数に入れて Next が終わった時に fr が 0のままなら入力は無かった。 0以外だったら、入力があって、何行目か?と言うと fr行目。＞VBAの関数?普通の関数? 普通の関数が一部、VBAでも使えます。番号の有無を調べるだけなら Sub 有無チェック() Dim kk, ws As Worksheet Set ws = Workbooks("book2.xls").Worksheets("sheet1") kk = Application.CountIf(ws.Range("A:A"), Range("B5").Value) If kk > 0 Then MsgBox "ありました。" Else MsgBox "ありません。" End If Set ws = Nothing End Sub こんな感じで Matchを使うとこんな感じ。 Sub どこにあるか() Dim kk, ws As Worksheet Set ws = Workbooks("book2.xls").Worksheets("sheet1") kk = Application.Match(Range("B5").Value, ws.Range("A:A"), 0) If IsNumeric(kk) Then MsgBox kk & "行目にありました。" Else MsgBox "ありません。" End If Set ws = Nothing End Sub 番号が重複していた場合 kkに入るのは、上側の行数になります。 (HANA) ---- HANA さん私結構HANA さんの問いかけ見逃していますね(- -) >全部「'A服〜D服の4行分ループ i = 1」ってなってますね。。。すごいコピペしたのでぜんぜん気付きませんでした^ ^;;;;;直して置きます。 >「貸し出し」の転記と「サイズ」の転記を別コードにするなら共通部分のデータをどの段階で消せば良いのかは考えないといけないですね。二つを一つにするんですか?できそうですね。 end withの後にサイズのwith〜入れる?かんじですね。 (許斐) ---- 私も返信忘れてました。。。＞＞マクロの記録をご活用でしたら＞そうなんですか?なるほどそのようにします。ただ、そう単純に行かない事も有りますので変更後はよ〜く確認して下さいね。 ◆ ＞二つを一つにするんですか? いや、一寸意味が違うと思います。。。。 Sub 貸出入力() Sub サイズ() と、それぞれ単独で動かせる作りにして有りますよね? これを、 1.ある時は「貸出入力」だけ実行 2.ある時は「サイズ」だけ実行 3.ある時は両方実行と言う使い方にすると・・・・ 3をした時は全てのデータを消せば良いですが 1の時は後で2をする可能性を考えると共通部部分のデータは消せませんよね。また、2の時も後で1をする可能性があるならやはり共通部分のデータは消せません。「別々にしてあるけど、必ず一連で作業をする」と言う事なら、転記作業が終わった後で今作ってある Public Sub 削除_Click() で、全部のデータを消してしまえば良さそうに思いますが。。。貸し出しのデータは例えば前年のデータが有っても使えませんがサイズなら、前年のデータが有るならそれをわざわざ書き直す必要は無いんじゃないかと。。。となると、その場合はやはり 1のパターンで実行する事になる? とか言う事なんですが。。。どの様にお考えでしょう? ・・・まぁ、ウエストとかは変わっちゃう人も居られそうなのであまり考えずに全て更新して仕舞う事にしておくのが安全かな? (HANA) ---- HANA さんフム。。。使う方々は年配の方が多いため作業単純にしたいと思っています。このデータ処理の流れは ○新規登録ボタン転記するのは新入社員のデータのみ(実行はいつも3番のみ) ○検索ボタンデータをみるため(実行は3番のみ) ○修正ボタン内容を修正する(実行は3番のみ) 作業着のため駄目になり易いのです。そのためサイズより貸出日付がコロコロ変わるんです。 ○削除ボタン退職者データを削除(実行は3番のみ) ↑これが設定処理です。 (許斐) ---- あらら、私は許斐さんか、有る程度エクセルが分かる方が既に出来ている表をリスト形式にまとめるために「コードで簡単に出来ないかなぁ」って事かと思っていたのですが＞使う方々は年配の方が多いためって事ですか。。。もしかして、ブックを三つに分けているのもデータブックはサーバーに置いて入力ブックは各端末に置いてなんて事を考えて居られるのですか? (HANA) ---- HANA さん＞「コードで簡単に出来ないかなぁ」 2年前まではエクセルのフォームでで約200人分作って管理したようです。すぐに検索できないかと言われマクロに変えようと考えました。＞もしかして、ブックを三つに分けているのも〜サーバにデータ三つあります。三つに分けているのは統一にしたいからです。（癖を付けたい(笑））担当者以外はフォームの検索はいいけどデータは触らないみたいな〜。こんな感じにしてみました。後は @を追加し Aメッセージに”○○シートの○○行目に重複職員番号があります。” なんてできたら超完璧なものに仕上がります。（☆▽☆） Sub 貸出入力() Dim mr As Long Dim i As Long, ii As Long, cn As Long Dim kk, ws As Worksheet '職員NO存在チェック Set ws = Workbooks("book2.xls").Worksheets("sheet1") @ Set ws = Workbooks("book3.xls").Worksheets("sheet2") kk = Application.Match(Range("E4").Value, ws.Range("A:A"), 0) If IsNumeric(kk) Then A MsgBox kk & "行目に職員番号重複ありました。" Else '服 With Workbooks("book2.xls").Sheets("Sheet1") （許斐） ---- ＞三つに分けているのは統一にしたいからです。（癖を付けたい(笑））済みません、よく分かりません。何を統一したいのでしょう? また＞使う方々は年配の方が多いためと言う状態で「入力するときは、後二つ別のブックを開いておかないといけないよ」ってのを徹底させるのには不安を感じますが。 (HANA) ---- >「入力するときは、後二つ別のブックを開いておかないといけないよ」・データの呼び出しの時も開く必要あるんですか? ・ファイル開かなくても処理できないのでしょか? ・シートを一つにすると重くはありませんか?(約200×115×2枚）（許斐） ---- 私はこれまで開いていることが前提のコードを書いています。＞シートを一つにすると重くはありませんか? 仮にデータを入れてやってみられては? (HANA) ---- ひとつのbookにしました。ちょと重いけどいちいち開くより・・・・。（許斐） ---- ＞ちょっと重いってのは、開くのに時間がかかりますか? そのブックにはデータしか入っていないですか? A1:DK200の範囲に「1/1」と入れたシートを二枚作成して試しましたがこちらではスムーズに開く様に思います。たとえば、ブックを別々にして三つ開く事を考えるとそれでも別々になっている方が動きが早いのですか? それとは別で。。。再度確認させてください。複数の人が同時にブックを開いて使用する様な運用を考えておられますか? (HANA) ---- HANA さん >こちらではスムーズに開く様に思います。私のPCも平気です。。。。担当に2択させたところ一つのbookを使うそうです（-。-） >複数の人が同時にブックを開いて使用する様な〜複数の人を使用しますが、複数の人が同時に開くことはあまりないと思います。 bookをーつにしたところエラーが発生しました。「インデェックスが有効な範囲にありません」なぜでしょか?? Set ws = Worksheets("貸出") （許斐） ---- ＞Set ws = Worksheets("貸出") でそのエラーが出たのならアクティブになっているブックに「貸出」と言うシート名のシートが無い事が考えられます。前後にスペース等要らない文字が入っていないか。等、確認してください。「貸出」シートはちゃんとある!! って事なら、問題のあるコードを全部載せてもらうのが良いかもしれません。また、Set するのではなく With を使って書いても良いかもしれません。 Set すると何をSetしたのか覚えておかないといけないので。。。 (HANA) ---- HANAさんありがとうございます。お陰様で思い通りになりました。登録はこれで完成です。（☆○☆）感激〜♪ またくると思いますので。その時もよろしくお願いします。＞前後にスペース等要らない文字が入っていないか。間に半スペースが。。。直したところ思い通りになりました。 (許斐） ---- 出来ましたか、良かったです。＞職員NO存在チェックは、E4セルに番号が入力された段階で行うのが良いのではないかと思います。そして、その際重複があったらそのデータを各セルに呼び出す。登録と逆をやれば大丈夫だと思います。重複が無かったら、各セルのデータをクリア。ただし、E4セルには入力したデータが残っていないといけませんが。って感じで出来ると良さそうですね。＞またくると思いますので。って事ですがせっかくなので、Public Sub 削除_Click() に関しても話を続けさせてもらえると良いと思うのですが。 (HANA) ---- HANA さんありがとうございます。今検索をチャレンジ中です。＞に関しても話を続けさせてもらえるととってもありがたいです。なんとなくこんな感じかな??としか。。。よろしくお願いします。 For Each WS In wb With WS For i = .Cells(WS.Rows.Count, 1).End(xlUp).Row To 1 Step -1 'A列最終データの一行上 If .Cells(i, 1).Value = kt Then '検索値と等しかったら .Rows(i).Delete 'この行を削除 End If Next End With (許斐） ---- そうなんです!! 行削除は下からループが基本なんです。たとえば↓の様な表で [A] [1] HANA [2] HANA [3] 許斐 [4] 許斐 [5] HANA [6] HANA [7] 許斐 [8] 許斐 HANAの行を消そうと思って、上からループの Sub 削除1() Dim i As Long, kt As String kt = "HANA" For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1).Value = kt Then Rows(i).Delete End If Next End Sub をすると、上手く行きそうで実際は上手く行きません。なぜだか分かりますか? ステップインで実行しながら考えてみてもらえると良いのですが。・・・って思いましたがもしかして＞'A列最終データの一行上って事は、下からループしておられる自覚が無い?? 一応、削除1 の下からループバージョンは Sub 削除2() Dim i As Long, kt As String kt = "HANA" For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If Cells(i, 1).Value = kt Then Rows(i).Delete End If Next End Sub と言う事になりますが。。。。それぞれ、iの値の変化の仕方にも注意して観察してみてください。 (HANA) ---- HANA さん＞For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 最終行の一行上より処理開始は分かりました。なぜ上から下からなのか分かりませんでした。実行したところ上からだと上の一行しか削除されず下からだと全部削除してくれますね。（??）（許斐） ---- えっと・・・＞For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 は「最終行の一行上より処理開始」では【無い】ですが最終行の一行上より処理開始【では無い事】が分かりました?? i = 最終行から 1 まで iの値を一つずつ減らしながら（=Step -1) のループです。だから、下から上と表現しました。 8行目のデータを確認して削除するか・しないか 7行目のデータを確認して削除するか・しないか : 1行目のデータを確認して削除するか・しないか一方、削除1の方は i = 1 から最終行まで iの値を一つずつ増やしながら実行されて行きます。 1行目のデータを確認して削除するか・しないか 2行目のデータを確認して削除するか・しないか : 8行目のデータを確認して削除するか・しないかステップインで実行すると、iの値が片方（削除2）は減っていって、片方（削除1）は増えていきますよね? ＞（??）エクセルになったつもりで上からループ（削除1）をワークシート上で実行してみてください。まず、 i = 1 の時 A1セルの値を確認して1行目を削除します。すると、2行目が1行目にあがってきます。（A2セルがA1セルの位置に来る。） i = 2 の時 A2セルの値を確認します。。。。 A2セルの値は「許斐」ってなってますね。意図した動きとしては「HANA」を確認してその行は削除なのですが。。。 (HANA) ---- HANAさんつまりこういうことですか?削除1の場合 [A] [1] HANA ←削除 [2] HANA [3] 許斐実行結果 [A] [1] HANA ←2番目のHANAが[1]行目にUPし、マクロは次行を処理するためですね。 [2] 許斐削除2の場合 [A] [1] HANA [2] HANA [3] 許斐 [4] 許斐 [5] HANA [6] HANA ← 削除実行結果 [A] [1] HANA [2] HANA [3] 許斐 [4] 許斐 [5] HANA [6] 6行目削除して行がUPしないので、次行行って処理しても支所がないため上手く実行できる。てことですね^^ （許斐） ---- はい。どの様な事に成ったのかは関係なく iの値は一つ増えますからね。さて、今回の場合はどうでしょう。「重複入力されない」が前提であれば下からループする必要は無いと思います。まぁ、下からループしても問題は無いのですが。 (HANA) ---- ありがとうございます。削除1で大丈夫ですね^ ^ すごく分かり易い解説をありがとうございます。いま迄なんと無く理解したものが明確になった感じです。 (許斐) ---- 上からループ・下からループが分かって頂けた様ですのでもう一つ。例えば、こんなデータを想定します。 [A] [1] 許斐 [2] 許斐 [3] HANA [4] 許斐 [5] 許斐 [6] 許斐 [7] 許斐 [8] 許斐今回も「HANA」の行を消すのですがこのデータは実際のデータにより近い「重複入力されない」が前提として有るデータです。削除1を実行すると（削除2でも同じですが）確かに 3 行目が削除されて希望する結果が得られます。でも、ご自身でやるときの事を考えてみてください。一致するデータが一つしかないのですから一つ一致した段階で、それ以降は確認しませんね? 1行目を見比べて違うので次の行へ 2行目を見比べて違うので次の行へ 3行目を見比べて同じなので行削除したら次の行へは行かず、見比べる処理を終了。現在のコードでは、Cells(Rows.Count, 1).End(xlUp).Row まで、ループ処理が繰り返されます。もしもデータが200行まで有って、3行目に「HANA」が有っても残り 4〜200 のループは繰り返され「見比べる」行為が実行されます。途中でもループ処理を終わって良い状態になればその段階で Exit For しましょう。 Sub 削除3() Dim i As Long, kt As String kt = "HANA" For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1).Value = kt Then Rows(i).Delete Exit For End If Next End Sub 今回の場合は、一致するデータが見つかって行を削除したらループ処理は終了すれば良いですね。これまでの二つと、最終的には同じ結果に成りますが [ F8 ] を押す回数は変わると思います。コードは一行増えましたけど。これも又、ステップインで実行しながら違いを確認して頂ければと思います。 (HANA) ---- そか^ ^そこまで気づかなかったです。無駄なループがなくなりますね。これはすごくいいですね。いろいろ使えそう。 Exit ForはForを使わなくても使えますか? 処理を中止ですからつかえそうなきも。。。あ!今のループで思い出しました。新規登録時の絶対条件 @名前と職員番号空欄は登録させないようにしない後が大変ですね。 p.s 月曜に検索と修正のレスして頂けますか? HANAさんのレスは非常分かり易く勉強になります。許斐 ---- ＞Exit ForはForを使わなくても使えますか? 微妙な発言ですね。（笑）途中でマクロを終了なら、Exit Sub ですがそう言うこと? ＞ @名前と職員番号＞空欄は登録させないようにしない後が大変ですね。本当ですね!! 確認する様にして下さい。両方データが有るときに Call ×3 ってな感じで。後は、実行速度の問題ですが登録・削除共にどうでしょう? 気になる程はかからないんじゃないかと思いますが。忘れない内にお伺いしておきたい事が有ります。貸出データはリセットされる様な事は無いのですか? 例えば「一年毎」とか。。。。ちなみに、現在完成している（完成しましたよね? ・・・「空欄は登録させない」は追加が必要なのか。）登録と削除のコードを再度載せてみてもらいたいのですが。（上記追加後の物を。）そうそうp.s返し有難う御座います。可能な限りレスさせて頂きます。他のみなさんも親切な方ばかりですから心配無いと思います。その際は新たに質問を立ててもらえると嬉しく思います。このスレも、かなり長くなって仕舞いましたので。ただ、こちらが終わるまではしばらくまって頂ければと思います。 (HANA) ---- >途中でマクロを終了なら、Exit Sub ですがそうなんですか。 forがあるので for i=1 to 3みたいのが必要かと思いました^ ^;;;; データはリセットしないです。上書き方式です。実行速度は一瞬です。^ ^d コードをのせるのは月曜にさせて下さい。本日は外にいるためケイタイで返事のみ。(. .") レスも終わったと思いましたがまだまだおぼえる事が多いですね。終了ご新しい質問を立ち上げます。許斐 ---- ＞for i=1 to 3みたいのが必要かと思いました^ ^;;;; えっと、よく分からないのですが。。。 For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row Exit For Next こう言ったことですか? For i〜（iのループ）から Exit します。たとえば For i = 1 to 3 For ii = 1 to 3 Exit For Next Next だと、iiのループからExit します。このコードだと、ii =1 の時が実行されたらすぐに Exit For するのでiiのループは無いも同然の結果になりますね。 Next と Next の間に一行入れて書くと i のループからExitです。 (HANA) ---- HANA さん理解しました。 Exitはそとにでる For i = 1 to 3のループでる場合は Exit Forで Subのループをでるときは Exit Subにすればオッケですね^^ ＞登録と削除のコードを再度載せてみてもらいたいのですが。 Sub 登録() Dim mr As Long Dim i As Long, ii As Long, cn As Long Dim kk, WS As Worksheet Dim msg As String Set WS = Worksheets("貸出") kk = Application.Match(Range("E4").Value, WS.Range("A:A"), 0) '職員番号と氏名チェック If Range("B5").Value = "" Then msg = vbLf & "氏名を入力してください。" End If If Range("E4").Value = "" Then msg = msg & vbLf & "職員番号を入力してください。" End If If Len(msg) Then MsgBox msg Exit Sub End If '職員NO存在チェック If IsNumeric(kk) Then MsgBox kk & "行目に重複の職員番号がありました。" Else '↓ダブりがないときの処理 '服 With Sheets("貸出") mr = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Cells(mr, 1).Value = Range("E4").Value '職員番号 .Cells(mr, 2).Value = Range("B5").Value '氏名 .Cells(mr, 3).Value = Range("B4").Value 'ふりがな .Cells(mr, 4).Value = Range("E5").Value '生年月日 .Cells(mr, 6).Value = Range("H5").Value '採用年月日 .Cells(mr, 8).Value = Range("H4").Value '階級 .Cells(mr, 9).Value = Range("J4").Value '所属 cn = 9 '9行目〜の設定 For i = 7 To 18 '行番頭 i = 1 For ii = 2 To 4 '列番号 cn = cn + 1 .Cells(mr, cn).Value = Cells(i, ii).Value Next Next For i = 7 To 17 '行番号 i = 1 For ii = 6 To 8 '列番号 cn = cn + 1 .Cells(mr, cn).Value = Cells(i, ii).Value Next Next For i = 7 To 18 '行番号 i = 1 For ii = 10 To 12 '列番号 cn = cn + 1 .Cells(mr, cn).Value = Cells(i, ii).Value Next Next .Cells(mr, 115).Value = Range("F18").Value '備考 End With 'サイズ With Sheets("サイズ") mr = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Cells(mr, 1).Value = Range("E4").Value '職員番号 .Cells(mr, 2).Value = Range("B5").Value '氏名 .Cells(mr, 3).Value = Range("B4").Value 'ふりがな For i = 1 To 5 '頭,首,胸囲 .Cells(mr, i + 3).Value = Range("B" & i + 20).Value .Cells(mr, i + 8).Value = Range("D" & i + 20).Value Next For i = 1 To 4 'キャップ,シャツ,上着,ズボン .Cells(mr, i + 13).Value = Range("F" & i+20).Value .Cells(mr, i + 17).Value = Range("H" & i+20).Value Next End With End If End Sub ------------------------- Sub 値をクリア() '氏名等 Range("B4:C5,E4:F5,H4:H5,H4:H5,J4").ClearContents '貸し出し Range("B7:D18,F7:H18,J7:L18").ClearContents 'サイズ Range("B21:B25,D21:D25,F21:F24,H21:H24").ClearContents End Sub ------------------------- Sub 行削除() Dim kt Dim k Dim wb(1 To 2) As Worksheet '異なるBookの（このばあい）2つのシートを参照します Dim WS 'WS はVariant型に変更します Dim i As Long Dim res As Long k = Worksheets("フォーム").Range("B5").Value kt = Worksheets("フォーム").Range("E4").Value Set wb(1) = Worksheets("貸出") Set wb(2) = Worksheets("サイズ") res = MsgBox(k & "のデータを削除しますか? ", vbYesNoCancel) If res = vbCancel Then Cancel = True MsgBox "キャンセルします。" Else For Each WS In wb With WS For i = .Cells(WS.Rows.Count, 1).End(xlUp).Row 'A列最終データ行より上にループして、 If .Cells(i, 1).Value = kt Then 'セルの値が検索値と等しかったら .Rows(i).Delete 'この行を削除 Exit For End If Next End With Next MsgBox "削除しました。" End If End Sub ---- Sub 登録() のコードに関してですが Set WS = Worksheets("貸出") kk = Application.Match(Range("E4").Value, WS.Range("A:A"), 0) この2行は、「職員NO存在チェック」の為のものですからこのコメントの下で処理をされるのが良いのではないかと思います。また、ここではせっかく Setしてあるのですが WSは一度しか使われていません。それなら、直接書いても良さそうな気もします。 kk = Application.Match(Range("E4").Value, Worksheets("貸出").Range("A:A"), 0) 検索と修正のコードを作成する際にこちらのコードも変更する事になるかもしれませんので（修正時の登録って、新規登録とほとんど同じだと思うので。）この辺りで一度仕切らせていただければと思います。 (HANA) ---- HANA さん＞kk = Application.Match(Range("E4").Value, Worksheets("貸出").Range("A:A"), 0) に変更しました。＞この辺りで一度仕切らせていただければと思います。このレス終了ていうことですね。親切に分かりやすいレスをありがとうございます。お陰様でマクロの勉強が少し楽しくなりました。次のステップもがんばりますp(^^)q （許斐） ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/200909/20090907110536.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ