[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『CSVデータ読み込み後の名前の定義について』（苦戦４日目）
以下のようなコードで、
CSVデータを開き、加工、別ブックにデータを転記しています。
作成時の容量は40KBだったのが、
現在は450KBです。
毎日開くのに10分以上かかったり、
途中で止まってしまう事もあります。
そこで教えていただきたいのですが、
名前の定義がものすごい量になっていて、
ExternalData_5253等となっています。
調べたところ、一括で削除する方法しか見つけることが出来ず、
削除していいものか困っております。
これは削除して問題ないものなのでしょうか？
また、名前の定義を蓄積させない為にはどのようにしたらいいのでしょうか？
ご教示よろしくお願いいたします。
Sub CSV取込_Click()
Dim r As Long
Dim myCnc1 As String
Dim myCnc2 As String
Dim myFileName As String
Dim sheet1 As Worksheet
'A-Q列のデータを削除
Columns("A:Q").ClearContents
'CSVをSheet1のB3セルで開きます
myFileName = "0出力.csv"
Set sheet1 = Worksheets(2)
sheet1.Activate
myCnc1 = "TEXT;"
myCnc2 = ThisWorkbook.Path & "\" & myFileName
With ActiveSheet.QueryTables.Add( _
Connection:=myCnc1 & myCnc2, _
Destination:=Range("B3"))
.TextFilePlatform = 932
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh
End With
With Range("P3").CurrentRegion
.AutoFilter Field:=15, Criteria1:="<80"
.Offset(1).EntireRow.Delete
.AutoFilter
End With
r = Range("C" & Rows.Count).End(xlUp).Row
Columns("M:M").Insert
Range("M4:M" & r).FormulaR1C1 = "=LEFT(RC[1],10)"
Range("M4:M" & r).Value = Range("M4:M" & r).Value
Range("N3").Copy Range("M3")
Columns("N:N").Delete
Columns("G:G").NumberFormatLocal = "0_);[赤](0)" '★修正
Columns("K:K").AutoFit
Rows(r + 1 & ":" & Rows.Count).Delete
Columns("C:C").AutoFit
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
FieldInfo:=Array(1, 5)
Selection.Cut
Columns("R:R").Select
Selection.Insert Shift:=xlToRight
Columns("Q:Q").Select
Selection.NumberFormatLocal = "yyyy/m/d"
Columns("O:O").Select
Selection.NumberFormatLocal = "G/標準"
Range("B3").Activate
Columns("A:R").AutoFit
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－--
Sub 転記()
Dim i As Long, ii As Long, MxR As Long
Dim tbl As Variant, tbl2 As Variant
Dim dic As Object
Dim MyBook As Workbook, ThSh As Worksheet
Dim MyPath As String, MyBkPath As String
MyPath = ThisWorkbook.Path & "\..\工事番号別"
Set ThSh = ThisWorkbook.Sheets("入荷")
Set dic = CreateObject("scripting.dictionary")
With ThSh
tbl = .Range("B1").Resize(.Range("B" & Rows.Count).End(xlUp).Row + 1, 16)
End With
For i = 4 To UBound(tbl, 1) - 1
dic(tbl(i, 11) & "_" & tbl(i, 10)) = ""
If tbl(i, 11) <> tbl(i + 1, 11) Then
'ブックが有るか確認
MyBkPath = MyPath & "\" & tbl(i, 11) & ".xlsm"
If Dir(MyBkPath) <> "" Then
'ブックを開いてデータをチェック
Set MyBook = Workbooks.Open(MyBkPath)
With MyBook.Sheets("発・入")
MxR = .Range("B" & Rows.Count).End(xlUp).Row
tbl2 = .Range("A1").Resize(MxR, 9)
For ii = 10 To UBound(tbl2, 1)
If dic.Exists(tbl(i, 11) & "_" & tbl2(ii, 2)) Then
.Range("I" & ii).Value = "済"
End If
Next
'保存して閉じる
.Parent.Save
.Parent.Close
End With
Set MyBook = Nothing
End If
End If
Next
Set ThSh = Nothing
Set dic = Nothing
End Sub
'------
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
ちゃんとコメント・プレビューしてから投稿（ページの更新）して頂いていないので、Excelバージョンがわかりませんが、
「校閲」－「ブックの保護と共有」で「ブックの保護」のチェックを外してください。
（???） 2015/07/02(木) 11:51
???さん、ありがとうございます。 コメントプレビューしてから投稿しましたし、 私からは以下の表示が出て見えるのですが… ＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞ 他にブックを開いている人もおりませんし、 ローカルにコピーしても同じ状況です。 ブックの保護も変更履歴も取っていません。
（苦戦４日目） 2015/07/02(木) 13:04
どうも [[20150630142644]] 『変更履歴の設定を解除する』（カルメン） への回答が間違って書かれてしまっているようだ。 （ねむねむ） 2015/07/02(木) 13:07
こちらの回答は、定義を消して良いかどうかは、定義した人に確認しないと判らないけど、リンク切れは消すこと。
（削除は「数式」－「名前の管理」で、まとめて可能）
どうやって混入したかは、使用しているブックのどれかに名前定義があり、これが自動的にコピーされてる可能性。
対策として、開かれるブック全ての名前定義を確認してみることです。
（Excel2010で確認したため、2007だとメニューが違うかも知れません）
（???） 2015/07/02(木) 16:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.