[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『モジュール内での変数について』（ゆき夫）
いつも参考にさせていただいています。 変数について２つ質問です。OSはXPでExcel2007を使用しています。
一つの標準モジュール内にSub1()とSub2()の２つのプロシージャを記載し、毎回必ずSub1()→Sub2()の順で処理をします。
①その際、自分のPC（会社のですが）ではSub1()で取得し変数に入れた値がSub2()に引き渡されたのですが、他の人のPCだと 「オブジェクト変数またはwithブロック変数が設定されてません」となってしまいます。確かに変数にポインタを当ててみると取得できていません。 どこが原因なのでしょうか。
②Sub1()とSub2()の間に作業を行うのですが、①ではその作業を手入力していました。それをダブルクリックイベントプロシージャで行なうようにすると、 自分のPCでもSub2()ではSub1()の変数が引き渡されませんでした。イベントプロシージャを使用すると引き継がれなくなってしまうものなのでしょうか？
この２つをどうぞよろしくお願いします。
Sub1()の処理内容 加工する顧客データファイル（Excel）を選んで開き（ここでは選んだファイル名とそのファイルが入っているフォルダ名を取得）、シートを移動してき 、関数を張り付け（ここでは最終行の取得）、フィルタをかけて手動で処理する対象データを抽出。 Sub2()の処理内容 手入力（手動で処理）したデータを反映させて（ここで最終行の値が必要になります）他の条件でフィルタをかけ直し、必要な列を抜き出して 新しいブックを開いて貼り付け、取得しておいたフォルダ名の記載をし、更にデータをコピーしてきて、移動してきたシートを元の顧客データファイルに戻す。
下記はコードです。長くて申し訳ございませんがどうぞよろしくお願いいたします。
---ThisWorkbook---②で使用するためのものです
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 And Target.Value = "" Then
Target.Value = Range("A1")
Target.Offset(0, 1).Select
ElseIf Target.Column = 1 And Target.Value = Range("A1") Then
Target.Value = ""
Target.Offset(0, 1).Select
End If
End Sub
---Module1---
Option Explicit
Private Wbook1 As Workbook '---このファイル
Private Wbook2 As Workbook '---加工ファイル
Private MyWb1RwMax As Long '---候補リストの最終行
Private FolderName As String '---選択フォルダパス名
Sub 目検対象抽出()
Dim ans As Integer
Dim OpenFileName As String
Dim i As Boolean
Dim MyRange As Range
Dim n As Integer
Dim FolderPath As String
Set Wbook1 = ThisWorkbook
'ファイルの選択告知
ans = MsgBox("次の 『ファイルを開く』 から加工する候補リストを選択してください。", _
vbOKCancel + vbInformation, "ファイルの選択")
If ans = vbCancel Then
MsgBox "キャンセルされました。もう一度 1.作業開始 から始めてください。", _
vbOKOnly + vbInformation, "通知"
Exit Sub
End If
'対象ブックを選択して開く
OpenFileName = Application.GetOpenFilename("Microsof Excelマクロ有効ブック もしくは Excelバイナリブック,*.xlsm;*.xlsb")
i = 0
If OpenFileName <> "False" Then
Set Wbook2 = Workbooks.Open(OpenFileName)
FolderPath = ActiveWorkbook.Path
n = InStrRev(FolderPath, "\")
FolderName = Right(FolderPath, Len(FolderPath) - n)
i = 1
End If
If i = 0 Then
MsgBox "キャンセルされました。もう一度 1.作業開始 から始めてください。", _
vbOKOnly + vbInformation, "通知"
Exit Sub
End If
'シート"名寄せ候補template"を移動してくる
Wbook2.Activate
Worksheets("名寄せ候補template").Move After:=Wbook1.Worksheets(1)
MsgBox "選択された加工用の候補リストファイルは、このファイルとは別に開いています。作業終了通知が出るまで閉じないでください。", _
vbOKOnly + vbInformation, "作業通知"
'B列の最終行取得
Worksheets("名寄せ候補template").Select
MyWb1RwMax = Range("C" & Rows.Count).End(xlUp).Row
'コピー元のデータを名寄せ候補Templateへ貼り付け
Worksheets("コピー元（TEST6用）").Range("DT1:EP4").Copy
Worksheets("名寄せ候補template").Range("DT1").PasteSpecial Paste:=xlPasteAll
Worksheets("名寄せ候補template").Range("EP1").Value = MyWb1RwMax - 3
Worksheets("コピー元（TEST6用）").Application.CutCopyMode = False
'各4行目の式を最終行まで貼り付ける
Worksheets("名寄せ候補template").Select
'DU4～DU列をセット
Set MyRange = Range("DU4:DU" & MyWb1RwMax)
'DU4のデータをセットした範囲までフィルコピー
Range("DU4").AutoFill Destination:=MyRange
'DV4～DV列をセット
Set MyRange = Range("DV4:DV" & MyWb1RwMax)
Range("DV4").AutoFill Destination:=MyRange
'DW4～DW列をセット
Set MyRange = Range("DW4:DW" & MyWb1RwMax)
Range("DW4").AutoFill Destination:=MyRange
'DX4～DX列をセット
Set MyRange = Range("DX4:DX" & MyWb1RwMax)
Range("DX4").AutoFill Destination:=MyRange
'DY4～DY列をセット
Set MyRange = Range("DY4:DY" & MyWb1RwMax)
Range("DY4").AutoFill Destination:=MyRange
'DY列を値として貼り付け
Range("DY4:DY" & MyWb1RwMax).Copy
Range("DY4:DY" & MyWb1RwMax).PasteSpecial Paste:=xlPasteValues
'DY列のGCIを排除
Selection.Replace What:="00GCI", Replacement:=""
'DZ4～DZ列をセット
Set MyRange = Range("DZ4:DZ" & MyWb1RwMax)
Range("DZ4").AutoFill Destination:=MyRange
'EA4～EA列をセット
Set MyRange = Range("EA4:EA" & MyWb1RwMax)
Range("EA4").AutoFill Destination:=MyRange
'EA列を値として貼り付け
Range("EA4:EA" & MyWb1RwMax).Copy
Range("EA4:EA" & MyWb1RwMax).PasteSpecial Paste:=xlPasteValues
'EA列のGCIを排除
Selection.Replace What:="00GCI", Replacement:=""
'EB4～EB列をセット
Set MyRange = Range("EB4:EB" & MyWb1RwMax)
Range("EB4").AutoFill Destination:=MyRange
'EC4～EC列をセット
Set MyRange = Range("EC4:EC" & MyWb1RwMax)
Range("EC4").AutoFill Destination:=MyRange
'EC列を値として貼り付け
Range("EC4:EC" & MyWb1RwMax).Copy
Range("EC4:EC" & MyWb1RwMax).PasteSpecial Paste:=xlPasteValues
'EC列のGCIを排除
Selection.Replace What:="00GCI", Replacement:=""
'ED4～ED列をセット
Set MyRange = Range("ED4:ED" & MyWb1RwMax)
Range("ED4").AutoFill Destination:=MyRange
'EE4～EE列をセット
Set MyRange = Range("EE4:EE" & MyWb1RwMax)
Range("EE4").AutoFill Destination:=MyRange
'EF4～EF列をセット
Set MyRange = Range("EF4:EF" & MyWb1RwMax)
Range("EF4").AutoFill Destination:=MyRange
'EG4～EG列をセット
Set MyRange = Range("EG4:EG" & MyWb1RwMax)
Range("EG4").AutoFill Destination:=MyRange
'EH4～EH列をセット
Set MyRange = Range("EH4:EH" & MyWb1RwMax)
Range("EH4").AutoFill Destination:=MyRange
'EI4～EI列をセット
Set MyRange = Range("EI4:EI" & MyWb1RwMax)
Range("EI4").AutoFill Destination:=MyRange
'EJ4～EL列をセット
Set MyRange = Range("EJ4:EL" & MyWb1RwMax)
Range("EJ4:EL4").AutoFill Destination:=MyRange
'目検のため機械チェックマージ対象(EI列=1)でフィルタの設定
Rows("3:3").AutoFilter
Rows("3:3").AutoFilter Field:=140, Criteria1:="1"
Range("DU:EL,DS:DS,DQ:DQ,DO:DO,DM:DM,DK:DK,W:DI,U:U,Q:S,G:O,D:E").EntireColumn.Hidden = True
Range("F:F").ColumnWidth = 35
Application.ScreenUpdating = True
Range("F3").Select
MsgBox "顧客名・法人格等の目視チェックを行なってください。", vbOKOnly + vbInformation, "作業中間通知"
End Sub
Sub 新規ファイル作成()
Dim i As Long
Dim Wbook3 As Workbook
Dim MyWb3RwMax As Long
Dim MyRange As Range
Dim Wb As Workbook
Dim flag As Boolean
'全て再表示させ、A列のチェック行をEG列のチェック行に1を入力
Worksheets("名寄せ候補template").Select
Rows("3:3").AutoFilter
Columns("C:EQ").EntireColumn.Hidden = False
ActiveWindow.ScrollRow = 4
Range("D2").Select
ActiveSheet.EnableCalculation = False '---再計算停止
For i = 4 To MyWb1RwMax ←←←←←←←←←←←←←←←←←←ここが引き継がれていませんので値が0のままです。
If Range("EI" & i).Value = 1 And _
Range("A" & i).Value = Range("A1").Value Then
Range("EJ" & i).Value = 1
End If
Next i
ActiveSheet.EnableCalculation = True '---再計算再開
'最終一括更新マージ対象（EK列=1）を抽出
Rows("3:3").AutoFilter Field:=142, Criteria1:="1"
'新ブックへの貼り付け
Range("C:C,E:E").Copy
Range("D1").Select
Workbooks.Add
Set Wbook3 = ActiveWorkbook
ActiveSheet.Paste
Worksheets("Sheet1").Name = "一括更新マージ対象"
Wbook1.Worksheets("名寄せ候補template").Range("EN1:EP3").Copy ←←←←←←←←←←←←←←←←←←ここで「オブジェクト変数または～」の表示。
Wbook3.Activate
Worksheets("一括更新マージ対象").Range("F5").PasteSpecial Paste:=xlPasteValues
Worksheets("一括更新マージ対象").Range("F:F").EntireColumn.AutoFit
Worksheets("一括更新マージ対象").Range("G4").Value = "セット数"
Worksheets("一括更新マージ対象").Range("H4").Value = "件数"
Worksheets("一括更新マージ対象").Range("G5:H7").Style = "Comma [0]"
With Range("F5:F7,G4:H7")
.BorderAround LineStyle:=xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
With Range("F4")
.HorizontalAlignment = xlRight
.Value = FolderName
End With
Rows("3:3").RowHeight = 31.5
Worksheets("一括更新マージ対象").Range("A1").Select
'名寄せ結果情報確認の準備（顧客統合コードをVALUE関数にて表示）
Worksheets("一括更新マージ対象").Copy After:=Sheets(1)
Worksheets("一括更新マージ対象 (2)").Name = "名寄せ結果情報確認用"
Columns("C:C").Insert Shift:=xlToRight
Range("B3").Copy Destination:=Range("C3")
With Range("C3")
.Font.Size = 8
.HorizontalAlignment = xlCenter
.Value = "顧客統合" & Chr(10) & "コード" & Chr(10) & "（数値化）"
End With
Range("C4").ClearFormats
With Range("C4")
.FormulaR1C1 = "=VALUE(RC[-1])"
.BorderAround LineStyle:=xlContinuous
End With
MyWb3RwMax = Range("A" & Rows.Count).End(xlUp).Row
Set MyRange = Range("C4:C" & MyWb3RwMax)
Range("C4").AutoFill Destination:=MyRange
Columns("C:C").EntireColumn.AutoFit
Range("A1").Select
'一括更新編集用の準備作成（顧客統合コードをTEXT関数にて表示）
Worksheets("一括更新マージ対象").Copy Before:=Sheets(2)
Worksheets("一括更新マージ対象 (2)").Name = "一括更新編集用の準備"
Worksheets("一括更新編集用の準備").Select
Columns("B:B").Cut
Columns("A:A").Insert Shift:=xlToRight
Columns("B:B").Insert Shift:=xlToRight
Range("A3").Copy Destination:=Range("B3")
With Range("B3")
.Font.Size = 8
.HorizontalAlignment = xlCenter
.Value = "顧客統合" & Chr(10) & "コード" & Chr(10) & "文字列化"
End With
Range("B4").ClearFormats
With Range("B4")
.FormulaR1C1 = "=TEXT(RC[-1],0)"
.Borders(xlEdgeTop).LineStyle = xlContinuous
End With
'M4の式を最終行まで貼り付ける
Set MyRange = Range("B4:B" & MyWb3RwMax)
Range("B4").AutoFill Destination:=MyRange
Range("A1").Select
'不要なシートを削除
Worksheets(Array("Sheet2", "Sheet3")).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Worksheets("一括更新マージ対象").Select
'名寄せ候補templateを元のファイルに戻す
Wbook1.Activate
For Each Wb In Workbooks
If Wb.Name = Wbook2.Name Then flag = True
Next Wb
If flag = True Then
Worksheets("名寄せ候補template").Copy After:=Wbook2.Worksheets(1)
MsgBox "これで作業は終了です。候補リストは上書保存、新しいファイルにはExcle 97-2003 ブックにて名前を付けて保存してください。作業用ファイルは保存せずに閉じてください。", _
vbOKOnly + vbInformation, "作業終了通知"
Else
MsgBox "最初に選択した加工用の候補リストファイルが見つかりません。ファイルを開き、この作業用ファイルのシート『名寄せ候補template』をコピーして上書き保存をしてください。新しいファイルにはExcle 97-2003 ブックにて名前を付けて保存してください。作業を終了します。", _
vbOKOnly + vbExclamation, "ファイルが見つかりません"
End If
End Sub
目検対象抽出 というプロシジャーを実行する。 ↑このプロシジャー内でモジュールレベルの変数にデータを設定
手動操作でセルをダブルクリック（イベントが発生）
新規ファイル作成 というプロシジャーを実行する ↑このプロシジャー内でモジュールレベルの変数を参照しようとすると、 モジュールレベルの変数に設定したはずのデータが設定されていない
という現象ですよね！！ VBAでは、モジュールレベルの変数が何らかの原因で初期化されてしまうという現象は、 今までにも報告されています。ただ、原因は一つではないようです。 私の知っているのは、ActiveXcontrolをシートに貼り付けると初期化される ですが・・・。
まず、何が起因しているか？ 簡単なコードで探ってみては？
例
thisworkbookに
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 And Target.Value = "" Then
Target.Value = Range("A1")
Target.Offset(0, 1).Select
ElseIf Target.Column = 1 And Target.Value = Range("A1") Then
Target.Value = ""
Target.Offset(0, 1).Select
End If
End Sub
標準モジュールに
private aaa as long
sub test1()
aaa=5
end sub
sub test2()
msgbox aaa
end sub
こんなコードで
test1の実行-----ダブルクリックでイベント発生-----test2の実行
これでtest2で変数（aaa）の値は どうなのか？
というように原因に近いづいていく ということです。
試してみてください。
ichinose
それってこれだと思うのですが、、(もし無関係でしたら済みません) ↓ [VBA] Public 宣言された変数の有効期間 http://support.microsoft.com/kb/408871/ja
(半平太) 2010/07/31 15:31
半平太さん、 リンク参考になりました。 スコープとして保障されているのはプロシージャ実行間だけだったんですね。 今までもやもやしていたのがすっきりしました。 (Mook)
ichinoseさんのおっしゃる通りですね。簡単なコードで試してみます。 ありがとうございました！
半平太さんもありがとうございました！ VBAの本を読んでも、ネットで調べても、変数の有効期限についての説明が全て同じで リンク先の存在を知らなかったので、なんだか少しだけ解消したような、 でも、さんざん調べてきたのに・・・と少し複雑ですが、 こんなこともあるんだと納得しました。
以前は出来ていて少々コードの編集をした時からエラーが出てきてしまったので このことを踏まえて再度チャレンジしてみます。
お二人の方、本当にありがとうございました。（ゆき夫）
半平太さんご紹介の本社サイトの >意図しないタイミング このタイミングに再現性があるなら、一つでも多く知りたいなあ という趣旨で 現象を調べてみることは良いことだと思います。
で、結論としては、上のサイトではシートにデータを保持しなさい ということですよね？
ゆき夫さんの事象の場合、モジュールレベルの変数は
> Private Wbook1 As Workbook '---このファイル > Private Wbook2 As Workbook '---加工ファイル > Private MyWb1RwMax As Long '---候補リストの最終行 > Private FolderName As String '---選択フォルダパス名
これですね！！ Wbook1 とWbook2は、オブジェクトではなく、ブック名として、セルに保存し、
range("a1").value="ブック1.xls"
運用時は、 workbooks(range("a1").value) とすれば、ブックオブジェクトの参照が可能です。
他のLong型やString型の変数もセルに保存することで解決できそうですよね？
又は、仕様を変更して
目検対象抽出 ----（イベントが発生）----- 新規ファイル作成
という流れをひとつのプロシジャーで実行する
なんて方法も検討材料になるでしょうか？
いずれにせよ、代替方法はありそうです。が、
オブジェクト変数が他に代替出来ないような事象はどうするのだろう？
(例えば、イベントを有しているオブジェクト等)
こんなとき、私は、別ブック内に変数だけを配置しています Book1がメインプログラムがあるブックに対し、 Book2が変数だけを配置するブックだとすると、
Book2のthisworkbookのモジュールに
private bk as workbook
Book1にて
sub appset()
set workbooks("book2").bk=thisworkbook
msgbox workbooks("book2").bk.name
end sub
いまところ、変数を別ブックに配置し、そのブックは、非表示又は、専用アドインブックにしておく ことで値を保持してくれています。
これで大丈夫という結論ではありませんが、別ブックに変数を配置する方法も試してみてください。
ichinose
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.