Results of 1 - 1 of about 28 for 平均 平日 (0.001 sec.)
平均 (1364), 平日 (459)
- [[20120125115757]]
- #score: 10346
- @digest: 611f1cc6a5cf6d02a326532fec8b177a
- @id: 57420
- @mdate: 2012-01-25T08:58:23Z
- @size: 9447
- @type: text/plain
- #keywords: itiran (136347), lnglastno (106830), lngsheetname (51665), lngrow (27244), sheetnm (26361), shikaku (17974), zero (16095), 力メ (12602), srcws (10558), ix (6000), 様式 (5168), 告書 (4928), 台帳 (4212), 覧表 (3877), activesheet (3277), 先程 (2400), activate (2370), cells (2290), 一覧 (2249), 連番 (2126), シー (1787), 報告 (1726), ト名 (1593), 編集 (1555), ート (1421), 転記 (1396), worksheets (1334), に転 (1323), タベ (1281), 大値 (1261), sheets (1089), 最後 (950)
- 『連番シート削除時のエラー退避方法』（aqua）
いつもお世話になっております。 今回、初めて投稿させていただきました。 現在、仕事で資格試験台帳のデータベースを作成しているのですが、どうしてもうまくいかなくて困っています。 ○データベース構成 SHEET1:入力メニュー（@免許台帳作成ボタン A様式追加ボタン） SHEET2:一覧表 SHEET3:様式 ○データベースの動き 入力メニューのAボタンを押す。 SHEET3の様式がコピーされ、連番でシート名が付番される。 '------------------------------------------- ' シート追加ボタンクリック '------------------------------------------- Private Sub CommandButton1_Click() Dim ix As Long ''添字 Dim lngLastNO As Long ''現在の最後のn諱E Dim lngSheetNAME As Long ''シート名退避 Dim sc As Long ''変数のクリア(ZERO=0 標準モジュールで定義) lngLastNO = ZERO ''最初のシートから、最後のシートまで繰り返す ''ixを1からシートのラストbワで、1ずつ足していく。 For ix = 1 To Sheets.Count Step 1 ''報告書の最後のb探す ''(ただし、報告書以外に数値のみの名称のシートが無いものとする) If IsNumeric(Sheets(ix).name) = True Then lngSheetNAME = Sheets(ix).name ''シート名最大値の取得 If lngLastNO < lngSheetNAME Then lngLastNO = lngSheetNAME End If End If Next ''追加するbフ算出 ''シートが一つも無い場合、初期値とする If lngLastNO = ZERO Then lngLastNO = CST_Start_No Else lngLastNO = lngLastNO + 1 End If ''シートの追・ Sheets("様式").Copy after:=Sheets("様式") ''追加したシートの名前を編集する(上記算出) ActiveSheet.name = CStr(lngLastNO) ''シートの編集 ''AJ1セルにシート名を編集 With ActiveSheet .Range("C1").Value = lngLastNO End With sc = Sheets.Count ActiveSheet.Move after:=Sheets(sc) End Sub 入力メニューの@ボタンを押す。 連番で作成された様式のシート内容がSHEET1の一覧表に転記される。 '------------------------------------------- ' 一覧表作成ボタンクリック '------------------------------------------- Private Sub CommandButton2_Click() Dim ix As Long Dim lngLastNO As Long ''現在の最後のn謫セ Dim lngRow_Itiran As Long ''現在編集中の一覧行 Dim busyo As String ''一覧表編集用、部署 Dim jyugyo As String '' 従業員 Dim name As String '' 名前 Dim seinen As String '' 生年月日 Dim nyusya As String '' 入社年月日 Dim shikaku As String '' 資格名 ''変数のクリア(ZERO=0 標準モジュールで定義) lngLastNO = ZERO ''最初のシートから、最後のシートまで繰り返す ''ixを1からシートのラストbワで、1ずつ足していく。 For ix = 1 To Sheets.Count Step 1 ''報告書の最後のb探す ''(ただし、報告書以外に数値のみの名称のシートが無いものとする) If IsNumeric(Sheets(ix).name) = True Then lngSheetNAME = Sheets(ix).name ''シート名最大値の取・ If lngLastNO < lngSheetNAME Then lngLastNO = lngSheetNAME End If End If Next ''一覧表シートを選択 Worksheets(CST_Itiran_SheetNM).Activate ''今あるデータの削除 With ActiveSheet lngRow_Itiran = 6 ''タイトル行の次の行か? Do Until .Cells(lngRow_Itiran, 1) = ZERO_L .Cells(lngRow_Itiran, 1).Value = ZERO_L .Cells(lngRow_Itiran, 2).Value = ZERO_L .Cells(lngRow_Itiran, 4).Value = ZERO_L .Cells(lngRow_Itiran, 5).Value = ZERO_L .Cells(lngRow_Itiran, 6).Value =ZERO_L .Cells(lngRow_Itiran, 7).Value =ZERO_L .Cells(lngRow_Itiran, 8).Value =ZERO_L lngRow_Itiran = lngRow_Itiran + 1 Loop End With ''報告書データから編集 lngRow_Itiran = 6 ''タイトル行の次の行か? ''添え字ixを開始bゥら現在の最大値まで1ずつ増やす。 For ix = CST_Start_No To lngLastNO Step 1 '現在の添え字bフシートをアクティブにし、各項目を取得する Worksheets(CStr(ix)).Activate busyo = ActiveSheet.Cells(2, 3) jyugyo = ActiveSheet.Cells(3, 4) name = ActiveSheet.Cells(4, 4) seinen = ActiveSheet.Cells(5, 4) nyusya = ActiveSheet.Cells(6, 4) shikaku = ActiveSheet.Cells(8, 4) '取得した項目を一覧表に編集する。 Worksheets(CST_Itiran_SheetNM).Activate ActiveSheet.Cells(lngRow_Itiran, 1) = CStr(ix) ActiveSheet.Cells(lngRow_Itiran, 2) = busyo ActiveSheet.Cells(lngRow_Itiran, 4) = jyugyo ActiveSheet.Cells(lngRow_Itiran, 5) = name ActiveSheet.Cells(lngRow_Itiran, 6) = seinen ActiveSheet.Cells(lngRow_Itiran, 7) = nyusya ActiveSheet.Cells(lngRow_Itiran, 8) = shikaku '一覧表の編集行を+1する lngRow_Itiran = lngRow_Itiran + 1 Next End Sub ここまではできているのですが、このマクロの場合、連番の途中でシートを削除して 欠番を出したら一覧表に転記できなくなってしまいます。 連番の途中でシートを削除しても、一覧表に転記できる方法がありましたらご教授いただけませんでしょうか? 私が考えたのは、シート削除時に欠番にならないようデータを削除したら、自動で削除したシート以降のシート名に連番を付け替えるという方法なのですが・・・。 このマクロも友達に教えてもらったので自分ではマクロが組めません。 申し訳ございませんが、よろしくお願いいたします。 ちなみにWindowsXP・EXCEL2002使用です。 ---- いろいろなやり方があると思いますし、ちょっと乱暴ですが For ix = CST_Start_No To lngLastNO Worksheets(CStr(ix)).Activate を For ix = 4 To Worksheets.Count Worksheets(ix).Activate としても出来るかと思います。 このマクロを書いた方はしっかりとした知識を持った方のようですから、マクロを 作ってもらうだけでなく、いろいろ教えてもらえると良いように思います。 (Mook) ---- Mook様 早速、ご教授下さいまして本当にありがとうございます。 先程、記述していただいたマクロで思っていたものが出来上がりました。 はい。 友達に今度色々教えてもらおうと思います。 自分でもマクロ記述できるようになったら嬉しいですよね。 頑張ります!! ありがとうございました。 aqua ---- 何度もすみません。 先程ご教授いただいたものでエラーを出さずに台帳を作成することはできたのですが、 '取得した項目を一覧表に編集する。 Worksheets(CST_Itiran_SheetNM).Activate ActiveSheet.Cells(lngRow_Itiran, 1) = CStr(ix) ↑ 台帳に該当するシート名も一緒に転記して いるのですが、これだとシートを削除する とシート名と台帳に転記されたシート名に ズレが生じてしまいました。 シート名と台帳に転記されたシート名を一致させるにはどうのようににしたら良いでしょうか? 申し訳ございませんが、またご教授いただけたら幸いです。 よろしくお願いいたします。 （aqua） ---- 先ほどのコードは良くかけているのですが、ひとつ難点は Activate を使用している 点です。 その点はとりあえず置いておいて、 ActiveSheet.Cells(lngRow_Itiran, 1) = Worksheets(ix).Name としてください。 (Mook) ---- Mook様＞ 何度もご教授下さいまして本当にありがとうございます。 先程のコードでバッチリできました。 とても助かりました。 もしよろしかったら、Activateを使用しない方が良い理由をご教授いただけませんでしょうか? お手数をおかけして申し訳ございません。 aqua ---- ちょっと言葉が過ぎたかもしれません。 難点というほどではないですが、複数のシートにまたがった処理をする場合は Activate や Select を駆使して処理をするよりも、シートを指定して処理をした方が わかりやすいですし、処理も早いということです。 （おまけとしては、ユーザ操作の干渉を受けないというのもあります。） 詳細はこのあたりを読んでみてください。 http://officetanaka.net/excel/vba/speed/s2.htm そうすれば、For 文の中は Dim srcWS As Worksheet Set srcWS = Worksheets(ix) ' ※間違っていたので修正しました With Worksheets(CST_Itiran_SheetNM) .Cells(lngRow_Itiran, 1) = srcWS.Name .Cells(lngRow_Itiran, 2) = srcWS.Cells(2, 3) .Cells(lngRow_Itiran, 4) = srcWS.Cells(3, 4) .Cells(lngRow_Itiran, 5) = srcWS.Cells(4, 4) .Cells(lngRow_Itiran, 6) = srcWS.Cells(5, 4) .Cells(lngRow_Itiran, 7) = srcWS.Cells(6, 4) .Cells(lngRow_Itiran, 8) = srcWS.Cells(8, 4) End With 程度にかけます。 これで実行してみれば、動作中にシートの切り替えが発生しないことが、わかると思います。 (Mook) ---- Mook様＞ 分かりやすいご説明、ありがとうございました。 早速教えていただいたコードに直してみたら、かなり高速で動きました。 この方式だと、一覧表に転記する時に、様式シートに画面が切り替えされず、スムーズに転記することができるのですね。 とても勉強になりました。 またご質問することがあるかと思いますが、その時はご指導の程よろしくお願いいたします。 ありがとうございました。 aqua... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201201/20120125115757.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97000 documents and 607841 words.
訪問者：