VBAを使用してシートの並び替えを簡単にする方法はありますか?

このQ&Aのポイント
  • WIN7 EXCELL2010を使用している場合、シートの並び替えが面倒です。VBAを使用してより効率的な方法を見つけたいです。
  • 下側が今月の並び、上側が来月の並びである参照図を考慮に入れて、VBAのマクロで下側から上側にシートを並び替えることは可能でしょうか?
  • シート名「記入」を一番左に、シート名「祭日」を一番右に配置することは可能でしょうか?また、シート名には日付を含めたいです。
回答を見る
  • ベストアンサー

複数の条件でVBAによるシートの並びえ変え

いつもお世話になります。 WIN7 EXCELL2010 です。 シート数が多くなると並び替えが大変で何とかして省力化を図りたいです。 インターネットのVBAでシートでシートの並び替えをいろいろ調べましたがただ単純に 昇順 降順 でした。 もう少し工夫したVBAが可能ならばと下記のように考え御指導を仰ぎたいです。 御指導を仰ぎたいのは、 参照図で説明しますと 下側 が今月の並びです。 上側が 来月です。 だから マクロで 下側 から 上側 のようにシートの並び替えがマクロで可能でしょうか。 もしも可能ならご教授いただけませんでしょうか。 条件 1 シート名「記入」 は一番左側に 条件 2 シート名「祭日」 は一番右側に 条件 3 例えば今月の場合、 08 が 「記入」右側 その右から 0801 0802 0803 0804 という具合に 9月になると 例えばコマンドボタンで 09 が 「記入」右側 その右から 0901 0902 0903 0904 です ※ 1月~12月分があって途中で重くなることもあって過ぎたシートは適時削除します。 参考に 下記マクロはすでに適用しています。 1) シート名のマクロ (A1に文字列の数字 例えば今日ですと 20140802 08 で文字列です) Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Call StName_change(Sh, Target.Value) End If End Sub Private Sub StName_change(Sh As Object, word As String) On Error GoTo era Sh.Name = word Exit Sub era: MsgBox word & "は無効な名前です" End Sub 2) 該当日 該当月の色付けマクロ Private Sub Workbook_Open() Dim mySheet As Worksheet For Each mySheet In Worksheets mySheet.Tab.ColorIndex = xlNone If mySheet.Name = Format(Now(), "mmdd") Or mySheet.Name = Format(Now(), "mm") Then mySheet.Tab.ColorIndex = 3 End If Next End Sub 何かむつかしい質問をしていますが是非是非ご協力いただけませんでしょうか。

質問者が選んだベストアンサー

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

>にシートの並び替えがマクロ sub macro1()  dim d as integer  worksheets("記入").move before:=worksheets(1)  worksheets(format(now, "mm")).move after:=activesheet  on error resume next  for d = 1 to 31  worksheets(format(now, "mm") & format(d, "00")).move after:=activesheet  next d  on error goto 0  worksheets("祭日").move after:=worksheets(worksheets.count) end sub

dorasuke
質問者

お礼

早速の御指導誠に有難うございます。 上手くできて感謝感謝です。

関連するQ&A

  • VBAで二つの構文を繋げるには

    いつもお世話になります。 WIN7 EXCELL2010 です。 1) A1に 数値化した日付を入力するとシート名表示に反映される。  例えば 2014/07/31 で A1 には 20140731 と入力するとシート名にも      20140731 が表示 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub 2) 1)で表示された複数のシートから今日のシート名になっているシートの色付けです。 Private Sub Workbook_Open() Dim mySheet As Worksheet For Each mySheet In Worksheets mySheet.Tab.ColorIndex = 19 If mySheet.Name = Format(Now(), "yyyymmdd") Then mySheet.Tab.ColorIndex = 3 End If Next End Sub 3) 各月をまとめたシートで シート名は 1~12 あります。 このシート名にも色付けするため下記マクロを追加したいのですが、1)のマクロとどう繋げばいいか分かりません。 Private Sub Workbook_Open() Dim sh As Worksheet     For Each sh In Worksheets         If isnumeric(sh.Name) Then             sh.Tab.ColorIndex = xlNone             If sh.Name = Month(Now) Then                 sh.Tab.Color = 255 ' 赤             End If         End If     Next End Sub 同じ Private Sub Workbook_Open() で始まるので丸められることが可能ならも含めていい方法を御指導いただけると幸甚です。 宜しくお願いします。

  • Excel VBA シート名を条件に使用して…

    Excel2003を使用しています。 C列に特定の文字が入力されたら、その行のG列に、ある数式を入力したく、イベントマクロを作成しましたが、シートがたくさんあるときや、シートの追加がある場合は、クラスモジュールを使用するとよいということを過去の質問から参考にさせていただき、下記のクラスモジュールを作成しました。 ------------------------------------------------------- Public WithEvents myApp As Application Private Sub myApp_sheetchange(ByVal sh As Object, ByVal target As Range)  If Len(sh.Name) = 4 Then   If target.Column = 3 And target.Row >= 4 Then    If target.Value = "特定の文字" Then     Cells(target.Row, 7).FormulaR1C1 = "=数式A"    End If   End If  End If End Sub ------------------------------------------------------- 上記マクロを使用しているBook中の30数枚のシート名は「1234」というように、4桁の数字(全角)になっているのですが、さらに条件を加えて、例えば、シート名の数字が「1250」以下の場合は、Aという数式を入力し、シート名の数字が「2000」以上の場合は、Bという数式を入力するという条件でも可能でしょうか? 可能な場合、どのようにコードを記述すればいいのでしょうか? よろしくお願いします。

  • マクロでシート名を変更を変更したい

    A1セルの値をシート名にするマクロは以下のとおりだと思います。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub では、E6セルの値をシート名にすることは可能でしょうか? よろしくお願いします。

  • エクセルでマクロを使って新規シートを作成する方法を教えてください!(条件あります)

    初めて質問するのですが、エクセルで原紙シートのマクロまで全てをコピーして新規のシートを作成させるにはどうしたらいいですか? 新規のシートの特定のセルに入力した時に新規シートが作成されるようにできますか? 原紙は Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Address = "$A$1" Then ActiveSheet.Name = Target.Value End If End Sub のマクロが現在できあがってます。これを残しつつできますか?よろしくお願いします!

  • シートのイベント VBA

    シートをクリックしたらシートをクリアしたいのですが クリックするセルがA1の場合は、マクロを実行させたくないのですが 下記のコードだとエラーになってしまいます。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Target.Range = Range("a1") Then Cells.Clear End If End Sub ”Range("a1")でなければ、Cells.Clearする” にはどうすればいいですか?

  • ThisWorkBookモジュールとSheetモジュールの両立

    エクセル2003でマクロを組んでいます。 Sheet1,Sheet2の2つのシートがあり、 片方のシートの"A4:G10"の範囲に値を書き込むと、もう片方の同じ位置に同じ値が書き込まれるようなマクロを組みたいです。 以前ここで教えていただいたものを改変して以下を作りました(ThisWorkBookモジュールです)。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim r As Range Dim Num As Integer Dim S As String, Sh_name As String Sh_name = ActiveSheet.Name Set r = Intersect(Target, Range("A4:G10")) If Not (r Is Nothing) Then Application.EnableEvents = False For Num = 1 To 2 S = "Sheet" & Num If S <> Sh_name Then Worksheets(S).Range(r.Address).Value = r.Value End If Next Application.EnableEvents = True End If End Sub ここまでは正常に動作します。 また、 Sheet1とSheet2のモジュールに、 A列のセルに値が入力された場合、同じ行のC列のセルの色を塗るという記述をしています。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Cells(Target.Row, 3).Interior.ColorIndex = 5 End If End Sub これらを同時に生かしたいのですが、 どのように書けばいいでしょうか。 EnableEvents = False/Trueを消してしまうと、 Worksheets(S).Range(r.Address).Value = r.Valueが実行されるたびにThisWorkBookモジュールが動いているようです。 そして2回目のSet r = Intersect(Target, Range("A4:G10"))でエラーが出ます。 (エラーは出ずとも延々と(無限ではない回数)ThisWorkBookモジュールを繰り返したコードもありました。) よろしくお願いします。

  • 今日の日付に該当するシート名に赤色を

    いつもお世話になります。 WIN7 EXCELL2010 です。 A1に「20140721」と記入しエンターキーを押すと下記のマクロでシート名が自動で「20140721」となるようにしています。 例えば今日(7月21日)になったら自動で赤色にしていくつかあるシートの中で今日のシートを目指させたいのでご指導いただけませんでしょうか。 参考に Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub 是非ご協力をお願いします。

  • シート及びファイル名の付け方

    Windows XP EXCELL2003です。 いつもお世話になります。 すでに下記でご指導いただきました。 http://oshiete1.goo.ne.jp/qa5331087.html ご教授を仰ぎたいのは  マクロを実行 した時この場合は アクティブなシートに名前がつきますが これをアクティブなシートに関係なく、シート「FUKU」に名前が付くようにしたい野ですがご教授いただけないでしょうか。 マクロは下記のように入っています。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 And Target.Column = 1 Then ActiveSheet.Name = Target.Value ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Target.Value End If End Sub よろしく御願いします。

  • マクロで二つの構文を繋ぐには

    いつもお世話になります。 WIN7 EXCELL2010 です。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub ThisWorkbook に上記のマクロに下記のマクロを追加したいのですが、 End Sub の ところを End If End With などに変えたのですがうまくゆきません。 御指導お願いできませんでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Set myRange = Intersect(Target, Range("M3:V27")) If Not myRange Is Nothing Then Select Case Target.Value Case "" Target.Value = "○" Case "○" Target.Value = "●" Case Else Target.ClearContents End Select Cancel = True End If End Sub 宜しくお願いいします。

  • Excelでシート名と最終更新日を自動表示したい

    Excelを使って (1)セルA1に入れた名目をシート名にし (2)セルH1には、最終更新日を自動で入れたいです。 調べた結果、 シート名を右クリックして「コードの表示」から (1)は Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub を入れてうまくいきましたが、 (2)は Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  If ThisWorkbook.Saved = False Then   Worksheets("Sheet1").Range("H1").Value = Date  End If End Sub を入れてみましたが(←調べましたもの) うまくいきませんでした。 単純に、 Private Sub Worksheet_Change(ByVal Target As Range) Sheets(1).Name = Range("B1") End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  If ThisWorkbook.Saved = False Then   Worksheets("Sheet1").Range("H1").Value = Date  End If End Sub とつなげて入れるのではだめなんでしょうか? それとも、(2)の何かが間違っていますか? ご教授願います。

専門家に質問してみよう