• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：シート番号追加VBA）

シート番号追加VBA

watabe007の回答

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

beeeeyan さん、こんにちは >今回はどのシート名にも属さないシートはページカウントとしてカウントしない どのシート名にも属さないシートのセルにページ番号を追加しない 総ページ数にも加えない なら Sub pageB() 　　Dim i As Long, 特定シート数 As Long, j As Long 　　For i = 1 To Worksheets.Count 　　　　If Worksheets(i).Name = "Sheet3" Then 　　　　　　特定シート数 = 特定シート数 + 1 　　　　ElseIf Worksheets(i).Name = "Sheet4" Then 　　　　　　特定シート数 = 特定シート数 + 1 　　　　End If 　　Next 　　For i = 1 To Worksheets.Count 　　　　If Worksheets(i).Name = "Sheet3" Then 　　　　　　j = j + 1 　　　　　　Worksheets(i).Range("G2") = "'" & j & "/" & 特定シート数 　　　　ElseIf Worksheets(i).Name = "Sheet4" Then 　　　　　　j = j + 1 　　　　　　Worksheets(i).Range("G3") = "'" & j & "/" & 特定シート数 　　　　End If 　　Next End Sub

beeeeyan
質問者

お礼

頼ってばかりですみません！ほんとに有難うございます！！ そして質問させて頂いた内容とはまた違った質問なのですが、何にも属さないシートを何が何行、何列書かれるか分からないが、そのシートの1行目の最終行を求めて、その隣の空白にページ番号を入れる方法などありますでしょうか？ 分かりづらい説明で申し訳ありません 名前が分かっているシートは教えて頂いたlike関数で指定して、それ以外の全く関係ない別紙などのネーミングのシートでどれくらいセルを使うかわからないけども、ページが一行目の記入されてるセルが途切れた隣の空白にページを入れたい、と言われた為、色々自分でも試したのですがコードエラーなど色々出て分かりませんでした… お時間あるときにまたお願い出来ましたら、宜しくお願い致します

この回答がついた質問に戻る
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • エクセルセルにページ番号を追加したい

    こんにちは 自分のちからではどうにも無理なので、お力をお借りしたいです 色々名前がついたエクセルのシートがあり、手前から順々にページ番号を振っていきたいのですが、特定の名前のシートがあったら番号を入れるセルの位置を変えたいです その位置を変えたい名前のものが複数あったら、その分4/13,5/13などその分もページが入るようにVBAで出来ますでしょうか？ とりあえず全てのシートの順番にセルにページ番号を入れるVBAは見つけたのですが、自分ではそれから更に改良など難しいです Sub pageA() Dim i As Long For i = 1 To Worksheets.Count: Worksheets(i).Range("G1") = "'" & i & "/" & Worksheets.Count: Next End Sub どなたかお力をお借りできれば、有難いです それとそのVBAがワークシートを開いたら作動するようにしたいです なにかと細かくてすみません

  • シート名でなくindex番号でシートの移動をしたい

    windows7 Excel2007でマクロ作成の初心者です。以下の点で困ってます。ご指導お願いします。 シートの次ページへ、およびページの前に戻るというコードをつくりましたが、文字列でなく、indexを使ってつくりたのでですが、思うようになりません。 現在のコードは Private Sub 次ページへ_Click() If ActiveSheet.Name <> "23.日本太郎" Then ActiveSheet.Next.Activate End If End Sub ---------------------------------- Private Sub 前に戻る_Click() On Error Resume Next If ActiveSheet.Name <> "1.日本花子" Then ActiveSheet.Previous.Activate End If End Sub これを Dim i As Integer For i = 1 To Worksheets.Count - 6 などを使って作りたいです、なぜかというとシートの増減で名前が変わったとき、いちいち名前を変更しなければならないからです。

  • 印刷後のVBAの実行　(3)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします

  • エクセル、ワークシートが保護されているかどうかを判断するVBAは？

    以下のように書いてもダメでした。 どう直せばよいでしょうか？ Sub TEST2() Dim n As Integer n = ThisWorkbook.Worksheets.Count For i = 1 To n If Worksheets(i).Protect = False Then MsgBox Worksheets(i).Name End If Next End Sub

  • 印刷後のVBAの実行　(2)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) 　　If ActiveSheet.Name = "Sheet1" Then 　　　　If Range("D6").Value = "" Then 　　　　　　Cancel = True 　　　　　　MsgBox ("名前を入力してください") 　　　　　　Range("D6").Select 　　　　　　Exit Sub 　　　　End If 　　Else 　　　　If ActiveSheet.Name = "Sheet2" Then 　　　　　　If Range("C11").Value = "" Then 　　　　　　　　Cancel = True 　　　　　　　　MsgBox ("受付時間を入力してください") 　　　　　　　　Range("C11").Select 　　　　　　　　Exit Sub 　　　　　　End If 　　　　Else 　　　　　　 　　　　　　Exit Sub 　　　　End If 　　End If 　　ActiveSheet.Range("A70:Y70").Copy 　　If Worksheets("Sheet3").Range("A1").Value = "" Then 　　　　Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues 　　Else 　　　　Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ 　　　　　　Paste:=xlPasteValues 　　End If 　　Application.CutCopyMode = False 　　ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23～30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?

  • VBAの書き方を教えてください　3

    何度も申し訳ございません。 以前にもこちらで質問させて頂いている者です。 Sheet1のrange("A1")をVLOOKUPで検索後の文字を取得し、同じ名前のシートを検索し、さらにrange("A1000")をアクティブにしてここからコードをつなげて処理しています。 range("A1")の処理が終わったら、range("A2")の処理に入り、range("A3") range("A4")を続けて処理を行っているのですが、range("A4")でVLOOKUPの検索が空白の場合、On Error GoTo myErrorで次のrange("A5")の処理に入りますが、On Error Gotoは1回のみの処理しかできないみたいで、range("A５")が空白の場合、実行時エラー9が発生してしまいます。 教えて頂いたコードを解読し、On Error Resume Nextなどを使おうとしているのですが、上手くできません。 １から10まで質問しっぱなしなのですが、どなたかご協力を頂けないでしょうか。 とりあえず自分の必要なコードはある程度省いて、2つ分のみ記載します。 本来この後、10回同じ処理を行います。 よろしくお願い致します。 Private Sub 記帳_Click() 　On Error GoTo myError1 　Dim i As Long 　Dim myFlg As Boolean 　　 For i = 1 To worksheets.Count If worksheets(i).Name = Range("A1").Value Then myFlg = True Exit For End If Next i If myFlg = True Then With worksheets(i) .Activate .Range("A1000").End(xlUp).Select 　　　ActiveCell.Offset(1, 0).Select 　 ActiveCell = Range("J1") ActiveCell.Offset(0, 1).Select ActiveCell = Range("K1") End With Else MsgBox "該当シートなし" End If myError1: On Error GoTo myError2 For i = 1 To worksheets.Count If worksheets(i).Name = Range("A2").Value Then myFlg = True Exit For End If Next i If myFlg = True Then With worksheets(i) .Activate .Range("A1000").End(xlUp).Select ActiveCell.Offset(1, 0).Select 　 ActiveCell = Range("J1") ActiveCell.Offset(0, 1).Select ActiveCell = Range("K1") End With Else MsgBox "該当シートなし" End If End sub

  • VBAの書き方を教えてください　２

    以前にこちらで質問をさせて頂き、（http://okwave.jp/qa/q8451754.html）これに、VBAを追記していきたいのですが、移動したシートがアクティブする方法がわかりません。 移動したシートのA1000をアクティブにする場合、教えて頂いたVBAにどこに何を入れれば宜しいのでしょうか？ よろしくお願いします。 Private Sub CommandButton1_Click() Dim k As Long, myFlg As Boolean For k = 1 To Worksheets.Count If Worksheets(k).Name = Range("A1") Then myFlg = True Exit For End If Next k If myFlg = True Then Worksheets(k).Activate Else MsgBox "該当シートなし" End If End Sub

  • 全くの初心者ですVBA

    どこが悪いかわかりません。 教えてください。 Sub テスト() Dim kekka As String Dim i As Integer tokuten = Worksheets("Sheet1").Cells(i, 1).Value For i = 1 To Worksheets("Sheet1").Range("A1").End(xlDown).Row.Count If tokuten >= 80 Then kekka = "合格" Else kekka = "不合格" kekka = Cells(i, 2) End If Next i End Sub シート１の A列に数値で得点が入っています。

  • Excel VBAでの質問

    以前、質問に回答頂きそれを実行してうまくいったのですが、 特定のsheetだけsheetのつくりが違うため、 このsheetは毎回なにも処理をしないという処理を加えたいのですが、 （例えばsheet5とsheet8は処理をしない） 下記のコードにどのように付け加えればよいでしょうか？ わかるかた宜しくお願い致します。 Dim i As Long For i = 1 To Worksheets.Count 　If Worksheets(i).Range("A1").Value = 10 Then Worksheets(i).Range("K1") = Worksheets(i).Range("A1") 　Worksheets(i).Range("A1:D80").ClearContents Next End Sub

  • ＶＢＡ　任意のシートからコピーを始める。

    教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する