• ベストアンサー

エクセル2003 並び替えとマクロ

OSはウィンドウズXPです。質門は、 1.シートを保護するとマクロが動かないこと 2.マクロの実行前にブックを新しく保存したいことです。 ワークシートは  B---略-----L---------N -------O   1 所在   コード  所有者  備考   2 東京    1    甲 3 埼玉    2    乙    ***   マクロはボタンで作動するようにして以下のようになってます。 Private Sub 所有者ソート_Click() タイトル = "選択" メッセージ = "所有者で並べ替えます" スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal yesno = MsgBox(メッセージ, スタイル, タイトル) If yesno = vbYes Then 上 = 5 左 = 2 右 = 25 '右端 25=X列 下 = Range(Cells(上, 左), Cells(上, 左)).End(xlDown).Row Range(Cells(上, 左), Cells(下, 右)).Select Selection.Sort _ Key1:=Range("N1") _ , Order1:=xlAscending _ , Header:=xlGuess _ , MatchCase:=False _ , Orientation:=xlTopToBottom _ , SortMethod:=xlPinYin End If End Sub B列からX列までデータがあり、VLOOKUP関数でリストから参照させたりしてます。この関数の入ったセルは変更したくないのでロックしてます。保護したまま並び替えできるとベストですが、できますか? さらに並び替えのミスで(たとえば選択範囲がN列までになってしまい備考欄が誰のかわからなくなった等)もとに戻したいとき、マクロだと"元に戻す"がきかないので、作業前の状態を保存しておきたいです。 ちなみにエクセルは初心者、マクロは初心者以下です。 素直にマクロを使わずにやったほうがよいですか?

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

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.2

作業前の状態を保存しておきたいのなら、そのシートは並べ替えしないで複製したシートで並べ替えればいいのでは? シート保護のパスワードが仮にXXXXとした場合、以下でお試しください。 Sub test1() ActiveSheet.Copy After:=ActiveSheet Set ns = ActiveSheet With ns .Unprotect Password:="XXXX" タイトル = "選択" メッセージ = "所有者で並べ替えます" スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal yesno = MsgBox(メッセージ, スタイル, タイトル) If yesno = vbYes Then 上 = 5 左 = 2 右 = 25 '右端 25=X列 下 = .Range(.Cells(上, 左), .Cells(上, 左)).End(xlDown).Row .Range(.Cells(上, 左), .Cells(下, 右)).Sort _ Key1:=Range("N1") _ , Order1:=xlAscending _ , Header:=xlGuess _ , MatchCase:=False _ , Orientation:=xlTopToBottom _ , SortMethod:=xlPinYin .Protect Password:="XXXX" End If End With End Sub

barnard
質問者

お礼

シートをコピーするべきでしたね。 単純なことに頭がまわらない・・・・ どうもありがとうございました。 わざわざ書いていただいて感謝します。

その他の回答 (1)

  • FEX2053
  • ベストアンサー率37% (7987/21355)
回答No.1

マクロが実行している間は、シートの保護が無くても大丈夫なはずなので SUB ActiveSheet.UnProtect : ActiveSheet.Protect END こうやって、マクロの開始前にシートの保護を解除、マクロの終了直前に シートの保護を設定すればいいです。詳細はVBAヘルプの「PROTECT」と 「UNPROTECT」を参照してください。

barnard
質問者

お礼

ありがとうございました。

関連するQ&A

  • 重複行を完全削除するエクセルのマクロ

    Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。

  • excelのマクロで2007だとエラーが。

    excel2003では動いていたマクロが2007では、エラーになってしまいます。 中断→デバッグ→再開→中断→デバッグ→再開、、、、 と中断しながらも10~20行ずつ進みます。 解決法がありましたら教えてください。 ※デバッグで確認すると「end if」で中断します。 Sub 仕分() Dim n As Long Dim nRow As Long Worksheets("シート名").Activate nRow = Range("A1").End(xlDown).Row For n = 2 To nRow If Cells(n, 6) = "条件1" Then Cells(n, 22) = "仕分け" ElseIf Cells(n, 6) = "条件2" Then Cells(n, 22) = "仕分けしない" ElseIf Cells(n, 6) = "条件1" And Cells(n, 7) = "条件2" Then Cells(n, 22) = "仕分け2" Else Cells(n, 22) = "OK" End If Next n End Sub

  • Excelマクロのことで教えて下さい

    初歩的なことですみません。 E列の値をF列に値を入れるために下記のマクロを組みました。 Sub test() Worksheets("Sheet1").Select Dim i As Long For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row Range("F2").Value = "=E2/1024/1024" Cells(i, 6).FillDown Range(Cells(2, 6), Cells(i, 6)).Copy Range("F2").PasteSpecial Paste:=xlValues Next i End Sub ところがF列に「値のみを貼り付け」をした時に、途中から同じ値のみがコピーされてしまい困っています。 (画像参照) うまく貼り付けることができるマクロをお教え下さい。 よろしくお願いいたします。

  • エクセル マクロについて

    エクセルでネットの情報(為替の値動き)を自動更新で取得しています。自動更新前の情報を同一シート(同一シートが無理な場合は別シートでもいいのですが…)にコピペし一覧にするマクロはありますか? Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then         'A1のセルの値が変化したら・・・ n = Cells(Rows.Count, "B").End(xlUp).Row + 1  ’B列の最終行を探しその次の行に・・・ Range("B" & n).Value = Range("A1").Value    ’A1の値を貼り付けていく End If End Sub これだと手動セルを上書きした時しか動いてくれませんでした。検索もしたのですが見当たらなくて困っています。お力を貸してください。

  • エクセルのマクロについて

    Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア~ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか?できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub

  • VBA エクセル 列の並び替え

    左から右にA、B、Cと値が入っています。 ABC以外の文字が列に入っていたら、削除するというマクロを組みましたが、範囲を設定するところでエラーが出てしまいました。 なぜでしょうか? 教えて下さい。 Sub arrange() Dim rg As Range Dim i As Long i = 1 Do rg = Cells(i, 1) If rg <> "A" And rg <> "B" And rg <> "C" Then Range(i & ":" & i).Delete End If i = i + 1 Loop Until (i & "1") = "" End Sub

  • マクロ 並び替え

    Sub 並べ替え() With Worksheets("Sheet1").Sort .SortFields.Clear .SortFields.Add Key:=Range("e6"), _ SortOn:=xlSortOnValues, _ Order:=xlAscending, _ CustomOrder:="金,銀,銅" .SetRange Range("a6:Cl16").CurrentRegion .Header = xlNo .Apply End With End Sub 6行目~16行目で並び替えを行ってほしいのですが、1行目から並び替えになります。 .SetRange Range("a6:Cl16").CurrentRegion と記入しているので6列目からになると思っていたのですが。 マクロ初心者のため詳しい方がいれば教えて下さい。

  • エクセル・並び替えのマクロ

    エクセルで並び替えのマクロを作ったのですが ___A ______B ______C ______D ______E ______F _____________G 1 (株)カネカ【東証1部 : 4118.T】 2 日付 __始値 _高値 _安値 _終値 _出来高 ___調整後 3 07/07 1,030 1,069 ___941 __974 30,772,000 ___974 4 07/06 1,057 1,093 1,016 1,033 26,904,000 1,033 5 07/05 1,080 1,086 1,023 1,051 26,541,000 1,051 6 07/04 1,113 1,209 1,087 1,098 36,317,000 1,098 7 07/03 1,096 1,128 1,020 1,124 23,988,000 1,124 8 07/02 1,098 1,147 1,020 1,105 28,609,000 1,105 9 07/01 1,100 1,158 1,078 1,082 17,808,000 1,082 このような表で マクロ記録開始 セルA3をクリック データ→並び替え 優先されるキー:日付・昇順 データ範囲の先頭行:タイトル行 マクロ記録終了 で、できたマクロが Sub Macro1() Range("A3").Select Range("A1:G9").Sort Key1:=Range("A3"), Order1:=xlAscending,Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal End Sub これを実行すると 1行目、2行目の(株)カネカ、日付、始値…、が8行目、9行目になってしまいます そこで、マクロの Range("A1:G9")を Range("A3:G9")に書き換えて Sub Macro2() Range("A3").Select Range("A3:G9").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal End Sub これを実行すると 日付が、07/07、07/01、07/02、07/03、07/04、07/05、07/06 の順番になってしまいます どうしたらよいのでしょう?

  • エクセルマクロで複数列のセルを選択した時でも正しく動作するようにしたい

    エクセルマクロで複数列のセルを選択した時でも正しく動作するようにしたい。 今、3列目に入力された値によって15列から17列の値を自動入力するように次の マクロを作りました。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 Then Exit Sub For Each r1 In Selection If r1.Cells(1, 1) <> "部品表" Then Cells(r1.Row, 15) = "-" Cells(r1.Row, 16) = "-" Cells(r1.Row, 17) = "-" End If Next End Sub 3列目のみのセルをペーストすると正しく動作しますが、1列目から3列目のセルにペーストすると何も動きません。 正しく動くようにするには、どう修正すればいいでしょうか?

  • EXCELで、範囲を検出してグラフを作成するマクロを作りたい!

    いつも本当にお世話になっております。 現在、データの範囲を検出して、グラフを作成するマクロを記録させて作っています。 ところが、範囲が固定されてしまい難儀しています。 下にそのマクロを転記いたしますので、ご指摘、ご指導頂ければと存じます。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2008/3/11 ユーザー名 : acmr ' ' Sheets("元データ入力").Select 上 = 3 左 = 1 下 = Range(Cells(上, 左), Cells(上, 左)).End(xlDown).Row 右 = Range(Cells(上, 左), Cells(上, 左)).End(xlToRight).Column Range(Cells(上, 左), Cells(下, 右)).Select Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin Charts.Add ActiveChart.ChartType = xlXYScatter ActiveChart.SetSourceData Source:=Sheets("元データ入力").Range("A3:C459"), PlotBy _ :=xlColumns ActiveChart.SeriesCollection(1).Delete ActiveChart.SeriesCollection(1).XValues = "=元データ入力!R4C2:R459C2" ActiveChart.SeriesCollection(1).Name = "" ActiveChart.Location Where:=xlLocationAsObject, Name:="元データ入力" ActiveChart.HasLegend = False End Sub

専門家に質問してみよう