これからの季節に親子でハイキング! >>

先日、こちらのカテゴリでお世話になった者です。

ご質問に関して、前記事の参照が必要となるため、以下に記載致します。

【参照元】http://okwave.jp/qa2538402.html

参照元のご回答を元に、無事商品管理のブックを完成させました。
その後、よく調べれば当たり前の事だったようなのですが、保護をかけると
オートフィルタが動作しない事が分かりました。

私なりに調べて、ブックが開かれるタイミングで.EnableAutoFilterの記述が
必要になる事がわかり、参照元ANo.2内の中を以下のようにしてみました。

Private Sub Workbook_Open()
  On Error Resume Next
  With ThisWorkbook
    .Unprotect Password:=BOOK_PASSKEY
    .EnableAutoFilter = True '追記した行です
    .IsAddin = False
    .Saved = True
  End With
  If mApp Is Nothing Then Set mApp = Application
  ' カスタムメニューをセルの右クリックに追加
  Call AddCustomMenu
End Sub

これではエラーが出て動かず、更に調べました所、Excel2003などの比較的
新しいバージョンでは、保護の際にオートフィルタの有効無効のチェックが
出来る事がわかりました。

私はExcel2000なので、そもそもが記述をしても仕様上、保護下でのオート
フィルタは無理なのでしょうか?

Workbook_Open()のすぐ下の行に記述すると、1度保護を解除してかけ直せば
保護下でもオートフィルタが動くのですが、保存して再度ブックを開くと
オートフィルタはまた無効になってしまいました。

今一歩と思うのですが、どうしてもうまく出来ません。
どのように追記をすればオートフィルタが可能になるでしょうか?
または、無理なのでしょうか。

よろしくご教授下さい。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

> 前回の記事で頂いたセットが、たくさんの機能を含んでおりまして



やり過ぎました...すみません。

よくよく考えれば、別にマクロ無効で開かれたところで問題なさそうです。
マクロの無効化対策はカットしましょう。

管理者用のシート一括保護・保護解除は自分の経験上、無いと非常に不便
なので残しておきますが、不要ならプロシージャごとカットして下さい。

メニュー追加コードがあるとどかーんとコードが長くなってしまうのですが、
最近のデジカメはやたらと大きな画像なので、段階的にでもサイズ指定して
画像を挿入できた方が便利だと思いす。で...これも残しておきますね。

前回はろくろくデバッグもしないし、開発用コードも残したままで投稿
してしまったので、細かな修正を何箇所かこっそり入れました。(´・ω・`)

全体を差し替えてみて下さい。長文ごめんなさい。

Option Explicit

' 設定 ------------------------------------------------------------------------
' シート保護のパスワードを設定(無しなら""とする)
Private Const PASSKEY = "123"
' 管理者パスワード(シートの一括保護・解除に使用します)
Private Const ADMIN_PASSKEY = "admin"
'------------------------------------------------------------------------------

Private WithEvents mApp As Application
Private mcMenu     As CommandBarControl

Private Sub Workbook_Open()
  Dim Sh As Worksheet
  On Error Resume Next
  If mApp Is Nothing Then Set mApp = Application
  Call AddCustomMenu
  ’以下の追加コードが今回のご質問の回答になるかと。
  Call SheetUnProtect
  For Each Sh In ThisWorkbook.Worksheets
    Sh.EnableAutoFilter = True
  Next
  Call SheetProtect
  ThisWorkbook.Saved = True
End Sub

' // このブック以外ではカスタムメニューを表示させない
Private Sub mApp_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window)
  On Error Resume Next
  If Not mcMenu Is Nothing Then
    If Wb Is ThisWorkbook Then
      mcMenu.Visible = True
    Else
      mcMenu.Visible = False
    End If
  End If
End Sub

' // 管理者メンテ用メニュー
Public Sub 管理者専用()
  Dim sPass   As String
  Dim iErrCount As Integer
  Dim iMode   As Variant
  On Error Resume Next
  Do While iErrCount < 3 ' 3 回までタイプミス OK
    sPass = InputBox("Caps キーや Numlock に注意して下さい", _
             "管理者パスワード")
    If sPass = ADMIN_PASSKEY Then
      iMode = InputBox("1: 全シート保護" & vbLf _
              & "2: 全シート保護解除", _
               "管理者メニュー")
      If Val(iMode) = 2 Then
        Call SheetUnProtect
        MsgBox "シート保護解除しました", vbInformation
      Else
        Call SheetProtect
        MsgBox "シート保護しました", vbInformation
      End If
      Exit Sub
    Else
      Call SheetProtect
      iErrCount = iErrCount + 1
    End If
  Loop
  MsgBox "認証に失敗しました", vbCritical
End Sub

' // マクロで画像を挿入
Private Sub InsertPic()
  Dim vFnames As Variant
  Dim vFname As Variant
  Dim sngZoom As Single
  Dim Pic   As Picture
  Dim sngW  As Single
  Dim sngH  As Single
  Dim iOffet As Integer
  On Error Resume Next
  vFnames = Application.GetOpenFilename( _
       FileFilter:="Image ファイル, *.jpg;*.bmp;*.gif;*.tif;*.png", _
       Title:="画像ファイルを指定して下さい", _
       MultiSelect:=True)
  If IsArray(vFnames) Then
    Application.ScreenUpdating = False
    With Selection
      sngW = .Width: sngH = .Height
    End With
    sngZoom = CSng(Application.CommandBars.ActionControl.Parameter)
    iOffet = 0
    For Each vFname In vFnames
      Set Pic = ActiveSheet.Pictures.Insert(vFname)
      With Pic
        .Placement = xlFreeFloating
        .Locked = False
      End With
      With Pic.ShapeRange
        .LockAspectRatio = msoTrue
        Select Case sngZoom
          Case 0: .Height = sngH
          Case 1: .Width = sngW
          Case 2: .LockAspectRatio = msoFalse
              .Width = sngW
              .Height = sngH
          Case 10 To 400 ' 10~400% を有効とする
              .Height = .Height * sngZoom / 100#
        End Select
        ' MultiSelect 時のオフセット
        .IncrementTop CSng(10 * iOffet)
        .IncrementLeft CSng(10 * iOffet)
        iOffet = iOffet + 1
      End With
      Set Pic = Nothing
    Next
  End If
End Sub

' // セルの右クリックメニューにカスタムメニューを追加
Private Sub AddCustomMenu()
  Dim Cmb   As CommandBar
  Dim sAction As String
  Set Cmb = Application.CommandBars("Cell")
  On Error Resume Next
  Cmb.Controls("画像の挿入(&D)").Delete
  Set mcMenu = Cmb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
  With mcMenu
    .Caption = "画像の挿入(&D)"
    .BeginGroup = True
    sAction = ThisWorkbook.FullName & "!ThisWorkbook.InsertPic"
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "選択範囲の縦を基準にする(&1)"
      .OnAction = sAction
      .Parameter = 0
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "選択範囲の幅を基準にする(&2)"
      .OnAction = sAction
      .Parameter = 1
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "選択範囲の縦横に合わせる(&3)"
      .OnAction = sAction
      .Parameter = 2
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "100%(&4)"
      .OnAction = sAction
      .Parameter = 100
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "75%縮小(&5)"
      .OnAction = sAction
      .Parameter = 75
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "50%縮小(&6)"
      .OnAction = sAction
      .Parameter = 50
    End With
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "25%縮小(&7)"
      .OnAction = sAction
      .Parameter = 25
    End With
  End With
  Set Cmb = Nothing
  If mApp Is Nothing Then Set mApp = Application
  On Error GoTo 0
End Sub

' // シートに対しパス付き保護をかけます
Private Sub SheetProtect(Optional ByRef Wst As Worksheet)
  ' 引数:[Wst] シートオブジェクト。省略するとブック内の全シート
  Dim Sh As Worksheet
  On Error Resume Next
  If Not Wst Is Nothing Then
      Wst.Protect Password:=PASSKEY, _
            UserInterfaceOnly:=True, _
            DrawingObjects:=False
  Else
    For Each Sh In ThisWorkbook.Worksheets
      Sh.Protect Password:=PASSKEY, _
            UserInterfaceOnly:=True, _
            DrawingObjects:=False
    Next
  End If
End Sub
' // シートの保護を解除します
Private Sub SheetUnProtect(Optional ByRef Wst As Worksheet)
  ' 引数:[Wst] シートオブジェクト。省略するとブック内の全シート
  Dim Sh As Worksheet
  On Error Resume Next
  If Not Wst Is Nothing Then
      Wst.Unprotect Password:=PASSKEY
  Else
    For Each Sh In ThisWorkbook.Worksheets
      Sh.Unprotect Password:=PASSKEY
    Next
  End If
End Sub
    • good
    • 0
この回答へのお礼

前記事に続きましてのご回答、誠にありがとうございます。
再導入に手間取ってしまい、半日ほど掛かってしまいましたが、
先ほど無事全ての機能が動作する事を確認できました。

管理者用の一括機能や、画像の縮小選択などは大変重宝を
させて頂いております。

近日中に実業務で導入する運びとなりました事をご報告させて
頂くとともに、改めてお礼を申し上げます。

お礼日時:2006/11/21 15:22

Private Sub Workbook_Open()


On Error Resume Next
With ThisWorkbook
.Unprotect Password:=BOOK_PASSKEY
●●Sheets("Sheet1").EnableAutoFilter = True
●●Sheets("Sheet2").EnableAutoFilter = True
●●Sheets("Sheet3").EnableAutoFilter = True
.IsAddin = False
.Saved = True
■■.Protect Password:=BOOK_PASSKEY, UserInterFaceOnly:=True
End With
If mApp Is Nothing Then Set mApp = Application
' カスタムメニューをセルの右クリックに追加
Call AddCustomMenu

▲▲▲
 With Sheets("Sheet1")
  .Unprotect password:="xyz"
  .EnableAutoFilter = True
  .Protect password:="xyz", userInterfaceOnly:=True
 End with
▲▲▲

End Sub
----------------------------------------------------

●●と■■を削除して、▲▲▲の間に配置
■■は文法ミス!!。ヘルプ参照のこと。

▲▲▲の前までのコードでどんな処理をしているか前回の質問回答をみてませんので、通常であればこれで上手くいきます。
 
尚、簡単のためSheet1のみしてあります。
 
    • good
    • 0
この回答へのお礼

引き続きのご回答、誠にありがとうございます。
記述する場所によって、記述の方法等が異なる点を教えて頂き
大変勉強になりました。

これだけの機能をVBAで白紙から書き込むには、まだまだ知識や
理解が足りていない点ありますので、マクロや関数などからでは
ありますが、少しずつ勉強を進めたいと思います。

お礼日時:2006/11/21 15:27

前の質問回答は見てませんが、


EnableAutoFilterプロパティは、WorkBookのプロパティではなくて、Sheetオブジェクトのプロパティです。
ですから、例えば、Sheet2のAutoFilterを使用可能にしたければ

Sheets("Sheet2").EnableAutoFilter = True

シートに保護が掛けてあるなら

 With Sheets("Sheet2")
  .Unprotect password:="xyz"
  .EnableAutoFilter = True
  .Protect password:="xyz", userInterfaceOnly:=True
 End with

全シートの場合は、For Each等でくるくる回す。

それから、
>「エラーが出て動かず」
このような場合は、先ず、そのエラー番号、エラーメッセージを書くべきです。
 

この回答への補足

その後、過去の記事なども検索しながら以下のような記述もして
みたのですが、お礼欄に記載したのと同じエラーになります。

※コード一部抜粋(コード全体は質問文の中「参照元」より先に
 記載があります。
Private Sub Workbook_Open()
On Error Resume Next
With ThisWorkbook
.Unprotect Password:=BOOK_PASSKEY
Sheets("Sheet1").EnableAutoFilter = True
Sheets("Sheet2").EnableAutoFilter = True
Sheets("Sheet3").EnableAutoFilter = True
.IsAddin = False
.Saved = True
.Protect Password:=BOOK_PASSKEY, UserInterFaceOnly:=True
End With
If mApp Is Nothing Then Set mApp = Application
' カスタムメニューをセルの右クリックに追加
Call AddCustomMenu
End Sub

やはり、他の記述などがあるせいでしょうか・・・

補足日時:2006/11/20 17:13
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
エラー記述のご指摘、痛み入ります。

エラーは、番号などなくファイルを開いた瞬間に表示されます。
「Microsoft Visual Basic」という題目の小さなウィンドウで、
「非表示モジュール ThisWorkbook 内でコンパイルエラーが発生しました。」
と表示されました。

これは、SheetオブジェクトのプロパティをWorkBookのプロパティに
記述してしまった事が原因なのかなと、onlyrom様の内容から推測を
しております。

ファイルが開かれた段階で、全てのシートが保護下であり、且つ
オートフィルタを有効にするには、ThisWorkBookプロジェクト内の
「Private Sub Workbook_Open()」の記述内にその指示を出さないと、
都度マクロを掛ける必要がある所までは分かってきたのですが、
前回の記事で頂いたセットが、たくさんの機能を含んでおりまして
単純に記述を入れますと、パスワードや保護が無効になってしまう
こともあって、再度のご相談をさせて頂きました次第です。

onlyrom様のご回答を元に、また調整をしてみたいと思います。

お礼日時:2006/11/20 15:17

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QエクセルVBA 保護シート&フィルタ実行 全シート

VBA超初心者です。

たくさんのシートのあるエクセルで、
シート保護後もフィルタを使用できるようにVBAを設定したいと思ってます。
(現在エクセル2000を使用してます)

ネットで調べてVBAを設定してみました。
しかし下記のようにするとコンパイルエラーになってしまうのですが、
正しい方法を教えていただけると助かります。

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Application.CommandBars("Cell").Reset
End Sub

Private Sub Workbook_Open()
  With Application.CommandBars("Cell").Controls.Add( _
           Type:=msoControlButton, Before:=1, Temporary:=True)
    .Caption = "AutoFilter"
    .OnAction = "ThisWorkbook.filter"
  End With
  With Worksheets.Select
    .Unprotect
    .EnableAutoFilter = True
    .Protect UserInterfaceOnly:=True
  End With
End Sub

Private Sub filter()
  On Error Resume Next
  Selection.AutoFilter
End Sub

VBA超初心者です。

たくさんのシートのあるエクセルで、
シート保護後もフィルタを使用できるようにVBAを設定したいと思ってます。
(現在エクセル2000を使用してます)

ネットで調べてVBAを設定してみました。
しかし下記のようにするとコンパイルエラーになってしまうのですが、
正しい方法を教えていただけると助かります。

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Application.CommandBars("Cell").Reset
End Sub

Private Sub Workbook_Open()
  With Applicatio...続きを読む

Aベストアンサー

変更前:
 With Worksheets.Select
  .Unprotect
  .EnableAutoFilter = True
  .Protect UserInterfaceOnly:=True
 End With

変更後:
 dim h as worksheet
  :
 For Each h In Worksheets
 With h
  .Protect UserInterfaceOnly:=True
  .EnableAutoFilter = True
 End With
 Next

QExcelシートの保護時にデータの並び替え

Excelシートの保護時にデータの並び替えを行いたいと考えています。
使用する予定のExcelは2003と2007です。

セルのデータを変更させたくないのでシートの保護を行うことになり、
その上でオートフィルタでの絞り込みや並び替えは使用したいという状況です。

Excelシートを保護する時のオプションで、次の4つにチェックをしました。
・ロックされたセル範囲の選択
・ロックされていないセル範囲の選択
・並べ替え
・オートフィルタの使用

オートフィルタの絞り込み表示は使用できましたが、並び替え時に保護の警告が表示されます。
シート上のセル全てのロックを解除して上記を行うと並び替えは出来るのですが、
データが変更できてしまうので意味がありません。

VBAでは制御可能という場合、マクロを無効にして起動された場合には
並び替えやオートフィルタが使用できなくなるので、出来るだけ避けたいと思います。

(できればVBAでの制御を行わずに、)
実現可能なのでしょうか?
教えて下さい。お願い致します。

Aベストアンサー

オートフィルタは使えるので問題は並べ替えだけです。
しかし保護されたセル範囲を並べ替える事はできません。なので実現は不可能です。

#シート保護時に「並べ替え」のチェックを入れなければ,そもそも並べ替えはできません
#チェックを入れても,保護されたセルを並べ替える事はできません
#保護されたシートで,保護されていないセル範囲だけが並べ替えできます。



ヤリタイ事の全てを実現したければ,マクロを併用し,有効にしないで開いたのでは何も出来ないよう仕込んでおくぐらいと思います。

作成例:
ThisWorkbookのシートに


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("Sheet1").Protect Password:=123
ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
Worksheets("Sheet1").Unprotect Password:=123
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub

などのように仕込み,さらにパスワードを見られないようにVBAProjectのプロパティで表示を保護しておくなどで。




#マクロからの操作は有効でシートを保護し,並べ替えだけマクロで行わせるような手もありますが,フツーの操作では出来ないという事なのでかえって使いにくいと考えます。

オートフィルタは使えるので問題は並べ替えだけです。
しかし保護されたセル範囲を並べ替える事はできません。なので実現は不可能です。

#シート保護時に「並べ替え」のチェックを入れなければ,そもそも並べ替えはできません
#チェックを入れても,保護されたセルを並べ替える事はできません
#保護されたシートで,保護されていないセル範囲だけが並べ替えできます。



ヤリタイ事の全てを実現したければ,マクロを併用し,有効にしないで開いたのでは何も出来ないよう仕込んでおくぐらいと思います。

作成...続きを読む

QExcel VBAのオートフィルタ解除について

こんばんわ。
現在、コマンドボタン(オートフィルタの設定)にオートフィルタを設定するようなマクロを登録しています。
そして、別のコマンドボタンにはオートフィルタの解除を実施するマクロを書きたいんです。

しかし、オートフィルタを設定していない時に、解除のマクロを実行するとエラーになってしまいます。どうしたら良いのでしょうか?

If・・・文を使って、対象セルにオートフィルタが設定している時は解除を実施し、オートフィルタが設定されてない時は、何も実施しない。

このようなマクロはどうしたら良いのでしょうか?

よろしくお願いします。

Aベストアンサー

フィルタされていないシートに対して実行すると、
実行時エラー'1004':WorksheetクラスのShowAllDataメソッドが失敗しました。
というエラーが出ます(多分)

対象のシートが必ずアクティブなら、
If ActiveSheet.AutoFilterMode Then
 'オートフィルタを解除
 ActiveSheet.AutoFilterMode = False
End If


対象のシートがアクティブでなく、シートを指定する必要があるなら
If Worksheets("sheet1").AutoFilterMode Then
 'オートフィルタを解除
Worksheets("sheet1").AutoFilterMode = False
End If
(シート名は適時変更要)

これで、どうでしょうか?

Qシート保護とグループ化機能を両立するマクロで

エクセル2010です。
任意のセルにロックをかけて、シートを保護しています。
さらに、グループ化の開閉(左の欄で+と-で展開したり畳んだりする)機能を使いたのですが、シートの保護がかかっていると通常ではこれができません。
そこで調べたところ、以下のマクロでそれが両立できることがわかりました。

Sub 保護したままグループ開閉()
With Worksheets("Sheet1")
.EnableOutlining = True
.Protect UserInterfaceOnly:=True
End With
End Sub

しかし、シート保護のメニューで「ロックされていないセルの範囲選択」と「セルの書式設定」にチェックを入れて許可にしているのですが、このマクロをかけると、「セルの書式設定」のチェックが外れてしまい、文字の色等が変えられなくなってしまいます。
これを防止するには、上記のコードをどのように変えれば良いでしょうか?
アドバイスよろしくお願いいたします。

Aベストアンサー

あなたのマクロを

.Protect allowformattingcells:=true

と修正します。

Qexcelの保護シートでのフィルタ

エクセルのシートにフィルタをかけたあと、シート保護すると
フィルタ機能が効かなくなります。
これって避けられない仕様なのでしょうか?

保護したシートの中身を参照したいのですが....

Aベストアンサー

Excelのバージョンが不明ですが、2002以降であれば、シートの保護
をかける際に「このシートのすべてのユーザーの許可する操作」欄で
「オートフィルタの使用」をONにしておけば、シートを保護しても
それまでと同じように通り、フィルタ機能を使えます。

Excel2000以前の場合は、残念ながら、方法はありません。

ソフトのご質問をなさる際には、必ず、バージョンの記入もお願い
します。

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Qエクセル:マクロ「Application.CutCopyMode = False」って?

エクセルのマクロを記録していると

「Application.CutCopyMode = False」

というものがよく出てきますが、これは何でしょう?
どういう意味のものかわかりません。
削除しても差し支えないのもでしょうか?

Aベストアンサー

「Application.CutCopyMode = False」の前で
セルのコピー、または切り取りを行っていると思います。
これは、その操作(セルのコピー、または切り取り)を無効にしているだけです。
------------
Range("A1").Select
Selection.Copy ← これを無効にしている
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
------------
上記の場合であれば、「Application.CutCopyMode = False」を削除しても問題ありませんが、
以下の場合、貼り付け処理でエラーになります。
------------
Range("A1").Select
Selection.Copy
Range("A2").Select
Application.CutCopyMode = False
ActiveSheet.Paste ← ココでエラー
------------
ご自分で、セルをコピーしてみると分かると思いますが、コピーした範囲が点線で点滅されます。
「Application.CutCopyMode = False」をすると、
その点滅がなくなります。

「Application.CutCopyMode = False」の前で
セルのコピー、または切り取りを行っていると思います。
これは、その操作(セルのコピー、または切り取り)を無効にしているだけです。
------------
Range("A1").Select
Selection.Copy ← これを無効にしている
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
------------
上記の場合であれば、「Application.CutCopyMode = False」を削除しても問題ありませんが、
以下の場合、貼り付け処理でエラーになります。
------------
...続きを読む

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列> <B列> <C列>
7/1 りんご 100円
7/2 ぶどう 200円
7/2 すいか 300円
7/3 みかん 100円

このような表があって、100円を含む行をそのままの形で、
別のセル(同じシート内)に抜き出したいのですが。

7/1 りんご 100円
7/3 みかん 100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は500行までとしていますが、必要に応じて変更して下さい

QVBAでのブック・シートの保護・解除について

エクセル2010のVBAでのブック、シートの保護&解除の方法について教えて頂きたく、
質問させて頂きます。

消されては困るシートや数式がある関係で、ブックオープン時にVBAでブックとシートにそれぞれパスワードをかけて保護しています。

VBAではシートの削除、作成、コピーなどを行っているため、VBA実行時のみ、保護を解除させるようにしたいと思います。

ただ、対象のシート自体にも入力したい項目があるため、その箇所については保護を解除しておく必要があります。

そして、VBA実行後、再度、その箇所以外にパスワードで保護をかけ直します。

イメージとしては下記のような流れになります。

対象ブック:ブックA
対象シート:シート1
パスワード:1234(それぞれ)
常時保護を解除しておきたいセル:range("A6:H106")

1.(オープン時には、)ブック保護&特定のセル以外のシート保護
2.VBA実行時には全ての保護解除
3.VBA終了時に、1の状態に戻る

どうぞよろしくお願い致します。

Aベストアンサー

>worksheetクラスのvisibleプロパティを設定

そういうお話はありませんでしたが。典型的な二度手間ですね。

「ブックの保護」された状態のブックでは、シートの表示・非表示を操作することは当然できません。
この部分では、回答した「シートの保護」のようには、マクロ側で回避する手段はありません。

元のご相談で書かれている通り、
>VBA実行時のみ、保護を解除させるようにしたい

素直に「VBAで(対象の/問題となる)操作をする際に」そのようにしてください。


作成例:
private sub Workbook_Open()
 dim i as integer
 for i = 1 to 3
  worksheets(i).protect password:=1234, userinterfaceonly:=true
 next i

 thisworkbook.unprotect password:=1234
 for i = 4 to 20
  worksheets(i).visible = xlsheethidden
 next i
 thisworkbook.protect password:=1234
end sub

>worksheetクラスのvisibleプロパティを設定

そういうお話はありませんでしたが。典型的な二度手間ですね。

「ブックの保護」された状態のブックでは、シートの表示・非表示を操作することは当然できません。
この部分では、回答した「シートの保護」のようには、マクロ側で回避する手段はありません。

元のご相談で書かれている通り、
>VBA実行時のみ、保護を解除させるようにしたい

素直に「VBAで(対象の/問題となる)操作をする際に」そのようにしてください。


作成例:
private sub Workbook_Open...続きを読む

QエクセルVBAでフィルタ抽出部分のみのコピー

エクセルVBAで売上帳を作成していますが、オートフィルタでデータ抽出した後、表示されている行のみをコピーして別シートに貼りつけるにはどうすればよいのでしょう?

別シートは指定したセルに値のみの貼り付けをしたいと思っています。

宜しくお願いします。

Aベストアンサー

こんにちは
マクロの記録で作成した一例です。コメントを読んで、適当にアレンジして下さい。

Option Explicit
Sub SampleMacro1()
'
' SampleMacro1 Macro
' マクロ記録日 : 2009/3/13
'
 'フィルター部分
 Selection.AutoFilter Field:=1, Criteria1:="=ほげほげ", Operator:=xlAnd
 '可視セルの選択
 Selection.SpecialCells(xlCellTypeVisible).Select
 '選択範囲のコピー
 Selection.Copy
 'コピー先のシート&セル選択
 Sheets("Sheet2").Select
 Range("A1").Select
 'ペースト
 ActiveSheet.Paste
 'コピー元シートに戻りコピー状態解除
 Sheets("Sheet1").Select
 Application.CutCopyMode = False
 Range("A1").Select
End Sub

外してたら、ごめんなさい

こんにちは
マクロの記録で作成した一例です。コメントを読んで、適当にアレンジして下さい。

Option Explicit
Sub SampleMacro1()
'
' SampleMacro1 Macro
' マクロ記録日 : 2009/3/13
'
 'フィルター部分
 Selection.AutoFilter Field:=1, Criteria1:="=ほげほげ", Operator:=xlAnd
 '可視セルの選択
 Selection.SpecialCells(xlCellTypeVisible).Select
 '選択範囲のコピー
 Selection.Copy
 'コピー先のシート&セル選択
 Sheets("Sheet2").Select
 Range("A1").Select
 'ペース...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング