• ベストアンサー

名前の定義の一括削除したいんです。

こんにちは。 先日、同一フォルダの複数ブックのワークシート名の変更とセルの幅の変更とセルへの色付けを教えていただきました。 そこから先に問題が発生して、毎月更新するファイルなので アクセスのクエリをエクスポートしていますが、エクスポート先の ブックに名前の定義が残っているため、ワークシート名を変更しても 前月のシートにデータを上書きしてしまいます。 なのでシートの名前の定義の削除を行いたいのですが、 Dim nm As Name  For Each nm In Application.Names   nm.Delete  Next のコードを以前の質問から検索して使用してみましたが nm.Delete のところで名前が正しくありませんと出てしまいます。 アクセスでエクスポートしてエクセルに張り付いた名前の定義は VBAでは削除できないのでしょうか? 最終的には同一フォルダの複数ブックのワークシートの 名前の定義をVBAで一括削除したいんですが・・・。 試してみたコードは下です。 結果はシート名(2)にシート名が変更されて 名前の定義は削除されていませんでした。 シート名を変更しているのでシート名と名前の定義の名称は 違っています。 Dim N As Object にしても結果は同様でした。 マクロの記録ではWorkbook.Names("AAA").Delete になっていて定義の名前を指定しないとダメなのかなとか 思っていたりします・・。 度々で申し訳ないですが、お知恵を頂戴できないでしょうか? Dim path$, wb As Workbook, wbName$ Dim ws As Worksheet, i& Dim nCount As Long Dim sVal As String Dim n As Name path = ThisWorkbook.path & "\" wbName = Dir(path & "*.xls") Do Until wbName = "" If wbName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(path & wbName) i = 2 Set ws = wb.Worksheets(wb.Sheets.Count) If Trim(ws.Range("T2") & "月") <> "" Then On Error Resume Next ws.Name = ws.Range("T2") & "月" nCount = 1 sVal = ws.Cells(1, nCount).Value Do While sVal <> ""  ws.Columns(nCount).EntireColumn.AutoFit  ws.Cells(1, nCount).Interior.ColorIndex = 15  nCount = nCount + 1  sVal = ws.Cells(1, nCount).Value for each n in wb.names   n.delete  next    for each n in ws.names   n.delete  next Loop If Err.Number <> 0 Then ws.Name = ws.Range("T2") & "月" & " (" & i & ")" i = i + 1 End If On Error GoTo 0 End If DoEvents 'Next wb.Save wb.Close End If wbName = Dir Loop Set wb = Nothing Set ws = Nothing

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんばんは。 >For Each n In wb.Names >n.Delete >Next 難しいですが、たぶん、VBAでは解決できないかもしれません。 結論から言うと、VBAで削除できない、「名前」があるということです。 >ワークシートが1つだからかなと手動で名前の定義を消して >次の月をエクスポートして再度実行してみましたが >ワークシート名は変わりますが、名前の定義が残ったままでした。 ダメ元ですが、一度、Names オブジェクトの親オブジェクトを変えて試してみてください。 Names オブジェクトの親オブジェクトは、Application, Book, Worksheet の三つあります。 Set a = Application.Names Set b = ActiveWorkbook.Names Set c = ActiveSheet.Names また、同じようなエラーの質問があります。今回は、違うかもしれませんが、Nameオブジェクトが、VBAで削除できなくなってしまう現象があります。 http://oshiete1.goo.ne.jp/kotaeru.php3?qid=2616426 名前を一括削除するマクロ 「実行時エラー"1004":その名前は正しくありません」 なお、 Dim path$, wb As Workbook, wbName$ Dim ws As Worksheet, i& ある程度、腕に自信のあるVBAプログラマでしたら、path$ のよう書き方は、古い書き方です。また、VBAには、ほとんど予約語がありませんが、 myPath As String という書き方のほうがよいです。i As Longです。

junichihirobe
質問者

補足

おはようございます。 その質問のトピックは私も見ました。 やはり削除は無理なんでしょうか・・。 n.Delete の部分を名前の定義の名前変更とかするにはどうしたら いいのでしょうか? 削除できないなら定義の名前をエクスポートの際に かぶらない名前に変えればできるかなとか思っています・・。 ご教授できないでしょうか?

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (3)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.4

こんばんは。 >やはり削除は無理なんでしょうか・・。 それは、バグというか、私の考えでは、ワークシート側とVBA側は、完全な一致をしていないからなのだと思います。 ですから、 >n.Delete >の部分を名前の定義の名前変更とかするにはどうしたら >いいのでしょうか? オブジェクトを取れれば、削除も出来れば、名前も変えることが出来ます。 名前登録が、'abc' を、'abb' に返るなら、  Application.Names("abc").Name = "abb" こんな風になるのですが、ただ、Namesオブジェクトを取得できればという条件付きです。 Names オブジェクトは使わないようにする、というのが、私が、いつもここで書いている話なのです。(そういうことを嫌がる人もいますが。) >削除できないなら定義の名前をエクスポートの際に >かぶらない名前に変えればできるかなとか思っています・・。 For Each n In wb.Names     n.Delete Next For Each n In ws.Names     n.Delete Next これで消えないとすれば、私の考えでは、そのプロセス自体が違うように思います。 何もない新規ブックに、Cells.Copy wb.ActiveSheet.Range("A1") のように表面だけ貼り付けたほうが良いようです。

junichihirobe
質問者

お礼

こんにちは。 色々ありがとうございます。 色々検証してみて、できました。 クエリ名を数字&文字列から文字列&数字に 逆にしてみたら、名前の定義の削除ができました。 元のコードで大丈夫になりました。 どうしてそうなるのかはわからずじまいですが・・・。 お手数をおかけしました。m(__)m

全文を見る
すると、全ての回答が全文表示されます。
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

下記で1つのブックの名前の名前を表示できるようです。 Sub test03() Dim sh As Worksheet Dim nm MsgBox Application.Names.Count MsgBox ActiveWorkbook.Names.Count For Each nm In ActiveWorkbook.Names MsgBox nm.Name Next End Sub MsgBox nm.Name を nm.Delete に変えると出来ると思う。 Sub test03() Dim sh As Worksheet Dim nm MsgBox Application.Names.Count MsgBox ActiveWorkbook.Names.Count For Each nm In ActiveWorkbook.Names MsgBox nm.Name Next For Each nm In ActiveWorkbook.Names nm.Delete Next End Sub 確認後は前半は削除のこと。 ーー フォルダ内のすべてのブックの場合さらにActiveWorkbookのところをFor eachdで捉えればすべてを削除できるでしょう。

junichihirobe
質問者

補足

おはようございます。 下のコードでやってみました。 定義の数も名前も一致しましたが 削除のnm.deleteのところでエラーになります。 nmでデバックになるようです。 For eachdはFor Eachd nm In ActiveWorkbook.Names にするということなのでしょうか? するとコンパイルエラーが出ます・・。 やはり、できないんでしょうか? 難しいですね・・・。 >Sub test03() >Dim sh As Worksheet >Dim nm >MsgBox Application.Names.Count >MsgBox ActiveWorkbook.Names.Count >For Each nm In ActiveWorkbook.Names >MsgBox nm.Name >Next >For Each nm In ActiveWorkbook.Names >nm.Delete >Next End Sub

全文を見る
すると、全ての回答が全文表示されます。
  • wolis
  • ベストアンサー率45% (14/31)
回答No.1

どらか1つのファイルを開いて、 Sub TEST()  Dim myName As Name  For Each myName In ActiveWorkbook.Names   myName.Delete  Next End Sub のマクロを実行した場合に、名前は削除されますか?

junichihirobe
質問者

補足

できません。 その名前は正しくありませんと出ます。 しかし、挿入→定義の中を見ると名前の定義があります。 ワークシートが1つだからかなと手動で名前の定義を消して 次の月をエクスポートして再度実行してみましたが ワークシート名は変わりますが、名前の定義が残ったままでした。 どうにかなりますか? 下のコードにして見ましたがダメでした。 Dim path$, wb As Workbook, wbName$ Dim ws As Worksheet, i& Dim nCount As Long Dim sVal As String Dim n As Name path = ThisWorkbook.path & "\" wbName = Dir(path & "*.xls") Do Until wbName = "" If wbName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(path & wbName) i = 2 Set ws = wb.Worksheets(wb.Sheets.Count) On Error Resume Next ws.Name = ws.Range("T2") & "月" nCount = 1 With ws.Rows(1) With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToLeft)) .Interior.ColorIndex = 15 .EntireColumn.AutoFit End With End With For Each n In wb.Names n.Delete Next wb.Save wb.Close End If wbName = Dir Loop Set wb = Nothing Set ws = Nothing End Sub

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • エクセルVBA名前の定義特定のシートの名前のみ削除

    いつもお世話になってます。 Excel2013のVBAより、特定のシート、例えばデータというシートに付けられた名前の定義を消す事は出来るでしょうか?他のシートの名前の定義は残しておきたいです。 ActiveSheet.Namesで指定しても消去されませんでした。 Sub Sample1() Dim n As Name For Each n In ActiveSheet.Names n.Delete Next End Sub

  • エクセルVBA 「名前の定義」について

    いつもお世話様です。エクセル2000での名前定義に関するVBA操作で疑問がありますのでよろしくお願い申し上げます。 (o。_。)oペコッ 以下のマクロで、あるエクセルのBOOKの名前の定義をすべて書き出してみました。 Sub Names_Check() Dim nm As Object Set sh = ActiveWorkbook.Worksheets.Add For Each nm In ActiveWorkbook.Names i = i + 1 sh.Cells(i, 1) = nm.Name sh.Cells(i, 2) = "'" & nm.RefersTo Next End Sub すると、なかにはセル範囲を参照していない名前の定義がけっこう見つかりました。 それらはよく見ると =○○○.xls!△△マクロ のようなマクロの名前を参照していました。 そんな名前の定義はつけた覚えが無いのですが、これは何でしょうか? なぜそのような名前の定義が出来てしまうのでしょうか? 次にセル範囲を参照していないこれらの名前定義を削除するため下記のマクロを書いてみたところ、「実行時エラー1004 その名前は正しくありません」というエラーがでてしまいます。 どう書いたら削除できるのでしょうか?(もちろん手動では削除できます。) Sub Del_NameRefQuestion() '不明な参照の名前定義削除 Dim nm As Object Dim mystr As String, ans As Integer For Each nm In ActiveWorkbook.Names If InStr(nm.RefersTo, "$") = False Then ans = MsgBox(nm.Name & "/" & nm.RefersTo, vbYesNo + vbQuestion, "削除しますか?") If ans = vbYes Then nm.Delete ’ここでエラー End If Next MsgBox "不明参照の名前定義削除完了", , " ( ̄ー ̄)v" End Sub

  • エクセルVBAで別BOOKに「名前の定義」のCopy

    前からあったエクセルのファイルのどこかが壊れたらしく、ときどき作業中に突然エラーとなってエクセル自体が落ちてしまうので、BOOKの複製では意味がないと考え、同じ内容のものを別BOOKに再作成するマクロを以下のとおり作ってみました。(新規作成のBOOKにこのマクロを貼ります) これで、VBAのモジュールを除き、再作成できたのですが、どういうわけか「名前の定義」を行なったセル範囲の一部が反映されません。 調べてみると、他のセルから参照されていない「名前の定義」がすっぽり抜け落ちるようにも思えるのですが、この理解であっているでしょうか? 他のセルから参照していなくとも、マクロで参照しているので抜け落ちるのは困ります。 どうすれば、すべての「名前の定義」が再作成されるでしょうか? Sub Book_Copy() Dim fn As String Dim wb1 As Workbook, wb2 As Workbook Dim ans As Integer, i As Integer Dim nm As Name Dim sh As Worksheet fn = Application.GetOpenFilename("エクセル ファイル (*.xls), *.xls") If fn = "False" Then Exit Sub Application.EnableEvents = False Set wb1 = Workbooks.Open(Filename:=fn, UpdateLinks:=1) Set wb2 = ThisWorkbook ans = MsgBox(wb1.Name & "を " & wb2.Name & " へCopyしますか?", vbYesNo + vbQuestion) If ans = vbNo Then Exit Sub For Each nm In wb2.Names nm.Delete Next nm For Each sh In wb1.Worksheets sh.Cells.Copy i = i + 1 If wb2.Worksheets.Count = i Then wb2.Worksheets.Add After:=Worksheets(i) Application.DisplayAlerts = False wb2.Activate wb2.Worksheets(i).Activate wb2.Worksheets(i).Cells.Select ActiveSheet.Paste wb2.Worksheets(i).Name = sh.Name Application.DisplayAlerts = True Application.CutCopyMode = False End If Next sh wb1.Close (False) Application.EnableEvents = True ActiveWorkbook.ChangeLink Name:=fn, NewName:=wb2.Name, Type:=xlExcelLinks Set wb1 = Nothing Set wb2 = Nothing End Sub

  • ExcelvbaRefersToRange名前削除

    いつもお世話になります。 指定シートの名前を削除するコードを教えていただき、試していたのですが、あるブックの時エラーになり、 : RefersToRange : <アプリケーション定義またはオブジェクト定義のエラーです。> : Range というエラーになっていました。 ウィンドウで中身をみると、下記のコードのnの中のRefersToとかの値がまったく違うブックの名前になっており、最後に#REF!がついていたのでこれが原因なんだろうと思いますが、どうすればよいか全く分かりません。 一応、見えない名前の定義を消去するようなコードをかけて、#REF!になっていいる名前の定義を300ほどでてきたのを消しています。 リンクの編集のコマンドもグレーになっているので、リンクもないと思います。 もともと、そのブックを改造したんだと思います。 正常に動作するものは、きちんと自分のブックのシート名になっていました。 何か方法はありますでしょうか? Sub sumple() Dim n As Name For Each n In ActiveWorkbook.Names If n.RefersToRange.Parent.Name = "データ" Then n.Delete End If Next n End Sub

  • エクセルで名前を削除するときに印刷範囲を削除しない方法について

    下記のマクロでエクセル内の名前を一括でいつも削除しています。印刷範囲を設定していると、「Print_Area」という名前が設定されており、これも削除されてしまうので、印刷範囲の設定がなくなってしまいます。 印刷範囲を消さないようにするにはどうしたらいいでしょうか? --- Sub NameDel() Dim nm As Name For Each nm In ActiveWorkbook.Names nm.Delete Next End Sub

  • 他ブックからのシートコピーのマクロ

    マクロ初心者です。 下記マクロを完成する事が出来たのですが、一部修正がうまくいかない為投稿させていただきました。 マクロ内容:エクセルファイルを指定し、選択したシートを現在のブックにコピーする その際、不要な名前管理を削除してからコピー 修正したい箇所:指定したブックからコピーした際、シート参照の数式が入っていると外部参照になってしまう。 やってみた事:(1)(i)の前にarrayを入れる→外部参照のまま (2)(i)を削除してみた→外部参照にならなくたったが際限なくシートをコピーし続けた Sub 名前管理削除() Dim myPath As String Dim wb_A As Workbook Dim i As Integer ' myPath = Application.GetOpenFilename(("Excelファイル,*.xls*,CSVファイル,*.csv"), , "ブックを選択して下さい。") If myPath = "False" Then Exit Sub Set wb_A = Workbooks.Open(myPath) Dim name As Object For Each name In Names If name.Visible = False Then name.Visible = True End If Next On Error Resume Next ' エラーを無視。(削除件数にカウントしてしまいます) For Each nm In ActiveWorkbook.Names If InStr(nm.Value, "#REF") > 0 Or _ InStr(nm.Value, "\") > 0 Then nm.Delete i = i + 1 Else End If Next nm ' 終了の表示 MsgBox "不要な名前定義を削除しました。" & vbCr & _ "削除定義件数=" & i & "件", vbInformation, cnsTitle For i = 1 To wb_A.Sheets.Count wb_A.Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Next wb_A.Close False End Sub 不勉強で申し訳ございませんが、何卒よろしくお願いいたします。

  • VBA で名前の定義をしたいのですが・・・

    初心者です。 いろいろ試してみたのですが、だめでした。 ご教授ください。 対象という名前を定義させたいと思っています。 定義の参照範囲は可変です。 定義したい範囲はSheet1のAA3からAAの最終行までです。 それでマクロの自動記録から名前の定義のコードを取ってきて 変数を代入してみましたが、参照範囲を正しく取ってきてくれませんでした。 Sub test() '対象の名前を定義する Dim n As Long n = Sheets("Sheet1").Cells(Rows.Count, 27).End(xlUp).Row Sheets("Sheet1").Select Range(Cells(3, 27), Cells(n, 27)).Select ActiveWorkbook.Names.Add Name:="対象", RefersToLocal:="=Sheet1!R3C27:RnC27" End Sub RefersToLocal:="=Sheet1!R3C27:RnC27"の部分を RefersToLocal:="=Sheet1!R3C27:R&n&C27" RefersToLocal:="=Sheet1!R3C27:"R"&n&"C27"" にしてもだめでした。 うまく範囲をとってくれる方法を教えてください。 お願いします。

  • 特定列を削除したい

    以下の同じフォルダに入った条件の合致したセルがある行を削除したいのです が色々検索しても下の処理にあてはまるようなものが見つかりませんでした。 どなたかお助けしていただけないでしょうか? お願いします。  特定条件合致行削除()     Dim path$, wb As Workbook, wbName$ Dim ws As Worksheet, I&  path = ThisWorkbook.path & "\"    wbName = Dir(path & "*.xls")    Do Until wbName = ""       If wbName <> ThisWorkbook.Name Then        Set wb = Workbooks.Open(path & wbName)         = 2       For Each ws In wb.Worksheets #####################################################################                   With ws                   この部分に特定範囲の中に条件(3つ)が含まれる行を削除する処理 を実行させたい。                    I = I + 1                 End With ######################################################################                         Next                         DoEvents                         wb.Save                       End If                    wbName = Dir                   Loop                Set wb = Nothing                Set ws = Nothing     MsgBox "第三処理が完了しました。処理完了です。",       vbInformation, "処理確認"         End Sub

  • マクロ 特定のシート以外を削除する

    いつも回答して頂きありがとうございます。 特定のシート以外を削除するマクロを作成して動作させたのですが、削除する時に『選択したシートにデータが存在する可能性が・・・』と聞いてきます。これを無視して削除を行わせたいのですがどうすればよろしいでしょうか?御指導の程宜しくお願い致します。 Sub シートの削除() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "データ元" And ws.Name <> "集計用" Then ws.Delete End If Next End Sub

  • 複数シートを順番に範囲指定してソートしたい

    以下のコードでアクセスからデータをエクスポート後に 複数(50くらい)シート名を変更し、シートを並び替えし、 列幅を整えています。 次にデータをソートしたいのですが、うまく範囲指定が できないで2日くらいすぎてしまいました。 以下の**でかこった部分で定義ができません。 どなたかお助けしていただけないでしょうか? よろしくお願いします。 うまく改行できないですいません・・。 **************************************************** h = 1 o = 29 ws.Columns(h & ":" & o).Select 範囲指定したいのはA列からAC列までのデータの入った 行数までです。 With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP)) **************************************************** Private Sub CommandButton1_Click() Dim path$, wb As Workbook, wbName$ Dim ws As Worksheet, i& Dim intLoopA As Integer Dim intLoopB As Integer Dim h As Long Dim o As Long path = ThisWorkbook.path & "\" wbName = Dir(path & "*.xls") Do Until wbName = "" If wbName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(path & wbName) i = 2 For Each ws In wb.Worksheets If Trim(ws.Range("A2")) <> "" Then On Error Resume Next ws.Name = ws.Range("A2") If Err.Number <> 0 Then ws.Name = ws.Range("A2") & " (" & i & ")" i = i + 1 End If On Error GoTo 0 End If For intLoopA = 1 To Sheets.Count For intLoopB = 1 To Sheets.Count - 1 If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then Sheets(intLoopB).Move after:=Sheets(intLoopB + 1) End If Next intLoopB Next intLoopA With ws.Rows(1) With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToLeft)) .Interior.ColorIndex = 15 .EntireColumn.AutoFit End With End With h = 1 o = 29 ws.Columns(h & ":" & o).Select With ws.Range(.Cells(1), .Cells(ws.Columns.Count).End(xlToUP)) .Sort _ Key1:=Range("G1"), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal End With End With DoEvents Next wb.Save End If wbName = Dir Loop Set wb = Nothing Set ws = Nothing MsgBox "処理が完了しました。", vbInformation, "処理確認" End Sub

専門家に質問してみよう