[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『連番シート削除時のエラー退避方法』（aqua）
いつもお世話になっております。 今回、初めて投稿させていただきました。 現在、仕事で資格試験台帳のデータベースを作成しているのですが、どうしてもうまくいかなくて困っています。
○データベース構成
SHEET1：入力メニュー（①免許台帳作成ボタン ②様式追加ボタン）
SHEET2：一覧表
SHEET3：様式
○データベースの動き
入力メニューの②ボタンを押す。
SHEET3の様式がコピーされ、連番でシート名が付番される。
'------------------------------------------- ' シート追加ボタンクリック '------------------------------------------- Private Sub CommandButton1_Click() Dim ix As Long ''添字 Dim lngLastNO As Long ''現在の最後の№取・
Dim lngSheetNAME As Long ''シート名退避
Dim sc As Long
''変数のクリア(ZERO=0 標準モジュールで定義)
lngLastNO = ZERO
''最初のシートから、最後のシートまで繰り返す
''ixを１からシートのラスト№まで、１ずつ足していく。
For ix = 1 To Sheets.Count Step 1
''報告書の最後の№を探す
''(ただし、報告書以外に数値のみの名称のシートが無いものとする)
If IsNumeric(Sheets(ix).name) = True Then
lngSheetNAME = Sheets(ix).name
''シート名最大値の取得
If lngLastNO < lngSheetNAME Then
lngLastNO = lngSheetNAME
End If
End If
Next
''追加する№の算出
''シートが一つも無い場合、初期値とする
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 ''現在の最後の№取得
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を１からシートのラスト№まで、１ずつ足していく。
For ix = 1 To Sheets.Count Step 1
''報告書の最後の№を探す
''(ただし、報告書以外に数値のみの名称のシートが無いものとする)
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を開始№から現在の最大値まで１ずつ増やす。
For ix = CST_Start_No To lngLastNO Step 1
'現在の添え字№のシートをアクティブにし、各項目を取得する
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
'一覧表の編集行を＋１する
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)
早速、ご教授下さいまして本当にありがとうございます。 先程、記述していただいたマクロで思っていたものが出来上がりました。
はい。 友達に今度色々教えてもらおうと思います。 自分でもマクロ記述できるようになったら嬉しいですよね。 頑張ります！！ ありがとうございました。
aqua
何度もすみません。 先程ご教授いただいたものでエラーを出さずに台帳を作成することはできたのですが、
'取得した項目を一覧表に編集する。
Worksheets(CST_Itiran_SheetNM).Activate
ActiveSheet.Cells(lngRow_Itiran, 1) = CStr(ix)
↑
台帳に該当するシート名も一緒に転記して
いるのですが、これだとシートを削除する
とシート名と台帳に転記されたシート名に
ズレが生じてしまいました。
シート名と台帳に転記されたシート名を一致させるにはどうのようににしたら良いでしょうか？
申し訳ございませんが、またご教授いただけたら幸いです。
よろしくお願いいたします。
（aqua）
先ほどのコードは良くかけているのですが、ひとつ難点は Activate を使用している 点です。
その点はとりあえず置いておいて、 ActiveSheet.Cells(lngRow_Itiran, 1) = Worksheets(ix).Name としてください。 (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)
分かりやすいご説明、ありがとうございました。 早速教えていただいたコードに直してみたら、かなり高速で動きました。 この方式だと、一覧表に転記する時に、様式シートに画面が切り替えされず、スムーズに転記することができるのですね。 とても勉強になりました。 またご質問することがあるかと思いますが、その時はご指導の程よろしくお願いいたします。 ありがとうございました。
aqua
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.