ママのスキンケアのお悩みにおすすめアイテム

実行時エラー'1004': アプリケーション定義またはオブジェクト定義について
Dim code As String
Dim lastrow As Integer
Dim i As Integer
Sub calc()
Dim code As String
Dim day_s As Integer, month_s As Integer, year_s As Integer
Dim day_e As Integer, month_e As Integer, year_e As Integer
Dim row_length As Integer
code = "998407.o"
day_e = 31
month_e = 12
year_e = 2005
day_s = 1
month_ = 1
year_s = 2005
Range("B4:H65536").ClearContents
For i = 0 To 365 * 0.65 Step 50
URL = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv"
If i = 0 Then
lastrow = 4
Call GETデータ
If Range("B4") = "" Then
Exit Sub
End If
Else
lastrow = Range("B4").End(xlDown).Row + 1
Call GETデータ
Range("B" & lastrow, "H" & lastrow).Delete
row_length = Range("B4").End(xlDown).Row
If row_length - lastrow < 49 Then
Exit For
End If
End If
Next
Range("B5:H65536").Sort key1:=Columns("B")
lastrow = Range("B4").End(xlDown).Row
Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd"
Range("A1").Select
End Sub
もうひとつ
Sub GETデータ()
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Cells(lastrow, 2))
↑ここにデバックで黄色になります。
.Name = "t?s=998407.o&g=d"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Subになります。Excel2007です。

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

A 回答 (3件)

多分、変数の定義がきちんとできていないと思います。



「Sub calc()」で
 URL = "URL;http://table.yahoo.co.jp/t?s="………
 を設定していますが、

「Sub GETデータ」では
 ActiveSheet.QueryTables.Add(Connection:=URL………

URL変数はどこにも定義していませんので、どちらのサブルーチンも個別の変数(ローカル変数)
になっています。
よって「Sub GETデータ」のURLは空文字のままです。
 
もしURLをモジュール変数かパブリック変数またはURLを受け渡せば良いかと思います。

【モジュール変数なら】
  Dim i As Integer
  Dim URL As String    ←追加
  Sub calc()

【パブリック変数なら】
  Dim i As Integer
  Public URL As String    ←追加
  Sub calc()

【変数の受け渡し】
  Call GETデータ(URL)
     :
     :
  Sub GETデータ(URL)
    • good
    • 0
この回答へのお礼

ありがとうございました。解決しました。著書のホームページを検索してみたところ、がっつり正誤表が記載されておりました。やれやれです。ありがとうございました。

お礼日時:2010/06/09 19:57

訂正する部分としては、上から順です。



'//
Dim lastrow As Integer
  ↓
Dim lastrow As Long  '任意です。

'//
Call GETデータ
  ↓
Call GETデータ(URL, lastrow)

'//
Sub GETデータ()
  ↓
Sub GETデータ(ByVal URL, ByVal lastrow As Long)

'//
 .Refresh BackgroundQuery:=False
 End With
End Sub
  ↓
 .Refresh BackgroundQuery:=False
 End With
 ActiveSheet.QueryTables(1).Delete '任意です。
End Sub
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/06/09 19:35

私のはEXCEL2003なのでよく判りませんが


URLという変数はどこで宣言していますか?
していない場合、ローカル変数と判断されているため
GETデータで使用している変数URLがNULL(空白文字)
になっているんじゃないでしょうか?

Option Explicitを付けて、デバッグしてみましょう。

Option Explicit '追加
Dim URL As String '追加
Dim code As String
Dim lastrow As Integer
Dim i As Integer

Sub calc()
:
:
End Sub

この回答への補足

ご教授ありがとうございます。今やってみたところ変わらず同じ場所がエラーです。
Dim i As Long
Dim URL As String
Dim code As String
Option Explicit
Dim lastrow As Integer

Sub calc()
Dim code As String
Dim day_s As Integer, month_s As Integer, year_s As Integer
Dim day_e As Integer, month_e As Integer, year_e As Integer
Dim row_length As Integer
code = "998407.o"
day_e = 31
month_e = 12
year_e = 2005
day_s = 1
month_s = 1
year_s = 2005
Range("B4:H65536").ClearContents
For i = 0 To 365 * 0.65 Step 50
URL = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv"
If i = 0 Then
lastrow = 4
Call GETデータ

If Range("B4") = "" Then
Exit Sub
End If
Else
lastrow = Range("B4").End(xlDown).Row + 1
Call GETデータ

Range("B" & lastrow, "H" & lastrow).Delete
row_length = Range("B4").End(xlDown).Row
If row_length - lastrow < 49 Then
Exit For
End If
End If
Next
Range("B5:H65536").Sort key1:=Columns("B")
lastrow = Range("B4").End(xlDown).Row
Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd"
Range("A1").Select
End Sub

Sub GETデータ()
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Cells(lastrow, 2))
.Name = "t?s=998407.o&g=d"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.Refresh BackgroundQuery:=False
     End With
       End Sub
何か間違っているところはありますでしょうか?初心者で困り果てています。

補足日時:2010/06/08 20:23
    • good
    • 0

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

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

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

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

QVBAマクロ実行時エラーの修正について

VBA超初心者です。

CSVファイルをインポートし、データ更新すると、下記エラーが起こります。

実行時エラー '-2147021882 (8007000e)'
データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。
Ctrl+Endキーを押して最後の空白でないセルに移動し、そのセルとデータの末尾との間にある
すべてのセルを削除またはクリアしてください。その後、セルA1を選択し、ブックを保存して最後の
セルをリセットしてください。

(以下にも文章ありますが、一部しか表示されません)

この時、「デバック」ボタンを押すと、以下のマクロ表示となります。

Sub データ更新()

’データ更新日報出力Macro
’マクロ記録日:○○○ ユーザ名:○○


  ScreenUpdating = False
Worksheets("sheet1")Select
Range("A2").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
  Range("A2").Select
End Sub

Sub ピボットテーブル更新日報印刷()
   Sheets("Sheet2").Select
Range("B14").Select
ActiveSheet.PIvotTables("ピボットテーブル1").RefreshTable
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:True
End Sub


この構文で、Selection.QueryTable.Refresh BackgroundQuery:=False が
 間違っているようなのですが、どうすればいいのか良くわかりません。
 どなたか教えていただけないでしょうか?

VBA超初心者です。

CSVファイルをインポートし、データ更新すると、下記エラーが起こります。

実行時エラー '-2147021882 (8007000e)'
データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。
Ctrl+Endキーを押して最後の空白でないセルに移動し、そのセルとデータの末尾との間にある
すべてのセルを削除またはクリアしてください。その後、セルA1を選択し、ブックを保存して最後の
セルをリセットしてください。

(以下にも文章ありますが、一部しか表示されません)

こ...続きを読む

Aベストアンサー

>Selection.QueryTable.Refresh BackgroundQuery:=False
この『構文』自体が間違っているわけではありません。
"sheet1"のA2セルに設定されているQueryTable(外部データ取り込み)
を更新する時に、エラーが発生して更新できない、という意味です。

おそらく、エラー原因はエラーメッセージそのままではないでしょうか。
『..空白でないセルをワークシートの外にシフトすることはできません..』

QueryTableの設定によっては、取り込みデータを挿入するようになっています。
例えば、シートの最下行にデータがあって、
取り込みデータを挿入するとデータがはみ出てしまう、という場合は
そういったエラーメッセージが出る事も考えられます。
#こちらの環境では再現できなかったので半分自信なしですが -"-

対策もエラーメッセージに書かれている通りです。
例えば"sheet1"で使用中のデータの最終行が1,000行だと思っていても、
それ以下になんらかの使用領域が残っている可能性があります。
Ctrl+Endキーを押してみてください。
"sheet1"の実際の最終セルに移動します。
その行から1,001行目までを選択して削除してください。
(実際に必要なデータがないかどうかを確認の上で。)
その後ブックを保存してください。

以上で解消すれば良いのですが。

または、QueryTableの設定を変更してみる方法もあります。
"sheet1"のA2セルを選択して右クリック。
[データ範囲のプロパティ]を開きます。
『変更されたレコード(行)のデータ更新時の処理:』

○新しいデータのセルを挿入し、使用されていないセルを削除する
になっていたら、
○既存のセルを新規データで上書きし、使用されていないセルはクリアする
に変更してみてください。

いずれかでも解消できない場合は
現在のシート状態と実際の利用の仕方などの詳細情報があると
他にアドバイスあるかもしれません。
(例えば外部データを取り込んだ後に数式や書式を設定していたりとか、
 何かの図形を配置しているとか)

>Selection.QueryTable.Refresh BackgroundQuery:=False
この『構文』自体が間違っているわけではありません。
"sheet1"のA2セルに設定されているQueryTable(外部データ取り込み)
を更新する時に、エラーが発生して更新できない、という意味です。

おそらく、エラー原因はエラーメッセージそのままではないでしょうか。
『..空白でないセルをワークシートの外にシフトすることはできません..』

QueryTableの設定によっては、取り込みデータを挿入するようになっています。
例えば、シートの最下行にデータがあ...続きを読む

Qエクセル マクロ実行時エラー’1004’

For~Next構文内でシートコピーしていると途中で、
実行時エラー'1004’
WorksheetクラスのCopyメソッドが失敗しました。
が表示されることがあります。

該当のFor~Next文は10回以上実行されているので、コードの誤りではないと思うのですが、なぜ「Copyメソッドが失敗」するのかわかりません。
理由/対処方法がわかればありがたいと思い質問させていただきます。

**該当コード**
Sub 評価シート作成()
  Sheets(社員一覧).Select
  行 = 1
  Do
    ReDim Preserve 社員CD(行)
    ReDim Preserve 氏名(行)
    社員CD(行) = Cells(行 + 1, 1).Value
    氏名(行) = Cells(行 + 1, 2).Value
    行 = 行 + 1
  Loop Until Cells(行, 1) = ""
  人数 = 行 - 2
  For 回数 = 1 To 人数
    Sheets(評価シート).Select
    Sheets(評価シート).Copy after:=Sheets(評価シート)
    ActiveSheet.Name = 氏名(回数)
    Cells(4, 5) = 氏名(回数)
    Cells(4, 3) = 社員CD(回数)
  Next 回数
End Sub
*****************************
よろしくお願いします

For~Next構文内でシートコピーしていると途中で、
実行時エラー'1004’
WorksheetクラスのCopyメソッドが失敗しました。
が表示されることがあります。

該当のFor~Next文は10回以上実行されているので、コードの誤りではないと思うのですが、なぜ「Copyメソッドが失敗」するのかわかりません。
理由/対処方法がわかればありがたいと思い質問させていただきます。

**該当コード**
Sub 評価シート作成()
  Sheets(社員一覧).Select
  行 = 1
  Do
    ReDim Preserve 社員CD(行)
   ...続きを読む

Aベストアンサー

ひょっとしてこれに該当するのかな?

Excel でプログラムを使用してワークシートをコピーするとランタイム エラー 1004 が発生する
http://support.microsoft.com/kb/210684/ja

QVBA マクロ エラー1004 アプリケーション定義またはオブジェクト定義のエラー

VBAで正当表と入力表の正誤判定を一気に行いたいのですが
If Cells(a, b).Value = Cells(c, d).Value Thenの部分で
エラー1004、アプリケーション定義またはオブジェクト定義のエラーと出てしまいます。
エラーの対処の仕方を調べたのですがわかりませんでした。
教えていただけるとありがたいです。

以下作ったプログラムです。

Sub 正誤判定()

Dim a
Dim b
Dim c
Dim d
Dim e
Dim i
Dim j
Dim x
Dim y
Dim hokan
Dim ytate
Dim xyoko

a = 3
b = 21
c = 3
d = 43
e = 2
i = 1
j = 1


Do While j < 261

Do While i < 11

If Cells(a, b).Value = Cells(c, d).Value Then
a = a + 1
c = c + 1


If Cells(a, b) = Cells(c, d) Then
hokan = Cells(e, b).Value
ytate = Range("B2:S15").Find(hokan, lookat:=xwhole).Row + 15
xyoko = Range("B2:S15").Find(hokan, lookat:=xwhole).Column
Cells(ytate, xyoko).Value = Cells(ytate, xyoko).Value + 1

Else

End If

Else

End If
a = a - 1
c = c - 1
b = b + 1
d = d + 2
i = i + 1

Loop
a = a + 3
c = c + 3
e = e + 3
j = j + 1

Loop

End Sub

VBAで正当表と入力表の正誤判定を一気に行いたいのですが
If Cells(a, b).Value = Cells(c, d).Value Thenの部分で
エラー1004、アプリケーション定義またはオブジェクト定義のエラーと出てしまいます。
エラーの対処の仕方を調べたのですがわかりませんでした。
教えていただけるとありがたいです。

以下作ったプログラムです。

Sub 正誤判定()

Dim a
Dim b
Dim c
Dim d
Dim e
Dim i
Dim j
Dim x
Dim y
Dim hokan
Dim ytate
Dim xyoko

a = 3
b = 21
c = 3
d = 43
e = 2
i = 1
j...続きを読む

Aベストアンサー

質問者ののマナーとして、こんなの回答者に読ませて、処理内容を割り出させるのでなく、どのセル範囲とどのセル範囲をくらべて、どういうロジック(3行おきとか)でどう比較してとかを、文章で判りやすく解説したものを載せるべきだ。解読時間がかかってしょうがない。
それに行数・列数を少なくしたモデル例を作って、そのコードで質問すべきだ。回答者でテスト実例を作ろうにも列・行が多いと作っていられない。
回答者は質問者の職場などでの義務付けられ教育役ではないから、それぐらい質問者ですべきだ。
ーー
コード作成スキルとして
少し読み解くと変数を乱発しすぎだと思う。そのため解読が難しい。
列と行を表すi,j2つだけで2重ループで繰り回しできそうに思う。
それに1行下を見るときIf Cells(a + 1, b) =で良いのに、一旦足して、処理後1引いてもとへ戻すなど複雑になるばかりだ。
>b = b + 1
d = d + 2
はなぜ不統一なのか理解できなかった。
ーー
#1のご回答でOKならもう良いが、でなければ
(1)Range("B2:S15")
(2)U3-AP(?)XX ?? 22列?
(3)AQ3-BL(?) XX ?? 22列?
3行ごとにまとめて考えて、第1行が等しく、かつ第2行が等しければ、第1行の語句で、Range("B2:S15").を探し、直下行と等しいかチェック。
など文章で読者に教えてよ。
ーー
私が短くしようとしてやった結果。途中で放棄したので動かないだろうが、コードについて、私の言い分に耳を傾ける気があるなら参考にしてください。
コードをすっきりさせれば、自ずとエラー原因は判る、エラーは無くなると思う。
Sub test01()
'--初期化
'--U3
a = 3 'cells(a,b)
b = 21
'---AQ3
c = 3 'cells(c,d)
d = 43
'--
For j = 3 To 260 Step 3
For i = 1 To 10 Step 2

If Cells(a, b).Value = Cells(a, b + 22).Value Then


'1行下行を見る
If Cells(a + 1, b) = Cells(a + 1, b + 22) Then
'下行も等しければ、
hokan = Cells(a, b).Value
ytate = Range("B2:S15").Find(hokan, lookat:=xwhole).Row + 15
xyoko = Range("B2:S15").Find(hokan, lookat:=xwhole).Column
Cells(ytate, xyoko).Value = Cells(ytate, xyoko).Value + 1
Else
End If

Else
End If


b = b + 1 ' ???
d = d + 2 ' ???


Next i
'--
Next j
End Sub

質問者ののマナーとして、こんなの回答者に読ませて、処理内容を割り出させるのでなく、どのセル範囲とどのセル範囲をくらべて、どういうロジック(3行おきとか)でどう比較してとかを、文章で判りやすく解説したものを載せるべきだ。解読時間がかかってしょうがない。
それに行数・列数を少なくしたモデル例を作って、そのコードで質問すべきだ。回答者でテスト実例を作ろうにも列・行が多いと作っていられない。
回答者は質問者の職場などでの義務付けられ教育役ではないから、それぐらい質問者ですべきだ。
...続きを読む

Q「Excel VBA」 Webクエリ マクロ「実行時エラー"1004"ファイルにアクセスできませんでした」

Webクエリを使って、「Yahooファイナンス」から日経平均株価の時系列データを取得したいのですが、うまくいきません。(TT)
下記に全コードを記載しますので、ご回答よろしくお願いします。

Dim url As String
Dim lastrow As Integer
Dim i As Integer

Sub Calc()
'価格データを取得するマクロ

'このマクロ内で用いる各変数を宣言
Dim code As String
Dim day_s As Integer, month_s As Integer, year_s As Integer
Dim day_e As Integer, month_e As Integer, year_e As Integer
Dim row_length As Integer

'変数に各値を代入
code = "998407.o" '株価コード
day_e = 31 '取得終了日
month_e = 12 '取得終了月
year_e = 2005 '取得終了年
day_s = 1 '取得開始日
month_s = 1 '取得開始月
year_s = 2005 '取得開始年

'価格データを取得
For i = 0 To 365 * 0.65 Step 50

'変数にURLを代入
url = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv"

'1回目の繰り返しの場合
If i = 0 Then
lastrow = "4"
Call Get_Data

'価格データが取得できなかった場合、マクロを終了させる
    If Range("B4") = "" Then
Exit Sub
End If

'2回目以降の繰り返しの場合
Else
lastrow = Range("B4").End(xlDown).Row + 1
Call Get_Data

'見出しのセルを削除
Range("B" & lastrow, "H" & lastrow).Delete
row_length = Range("B4").End(xlDown).Row

'価格データが取得期間分存在していなかった場合、その時点で繰り返しを終了させる
If row_length - lastrow < 49 Then
Exit For
End If
End If
Next
End Sub

Sub Get_Data()

With ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Cells(lastrow, 2))
.Name = "t?s=998407.o&g=d"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "22"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Range("B5:F54").Select
Selection.Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End Sub

Calcマクロを実行すると、 
「実行時エラー"1004"ファイルにアクセスできませんでした。次のいずれかを行ってください。」 というエラーが出て止まってしまいます。

デバッグをすると、「Get_Dataマクロ」内の、
.Refresh BackgroundQuery:=False が黄色になります。

ステップインしても、やっぱり、
.Refresh BackgroundQuery:=False の所でエラーが出ます。(TT)

どうしても解決したい内容なので、
少しでも「解決の可能性」があれば、なんでも試してみたいと思っていますので、どうぞお気軽に回答お願いします。

力を貸しください。よろしくお願いします。

Webクエリを使って、「Yahooファイナンス」から日経平均株価の時系列データを取得したいのですが、うまくいきません。(TT)
下記に全コードを記載しますので、ご回答よろしくお願いします。

Dim url As String
Dim lastrow As Integer
Dim i As Integer

Sub Calc()
'価格データを取得するマクロ

'このマクロ内で用いる各変数を宣言
Dim code As String
Dim day_s As Integer, month_s As Integer, year_s As Integer
Dim day_e As Integer, month_e As Integer, year_e As Integer...続きを読む

Aベストアンサー

試したところ、ちゃんと動作しましたのでコードの問題ではないでしょう。

で、検索したところ同じような質問があり、
インターネット一時ファイル、履歴を削除したら解決したようです。
下記URLを覗いてみてください。

http://okwave.jp/qa2884378.html

外しましたらご容赦願います。
 

Q実行時エラー'1004': アプリケーション定義またはオブジェクト定義のエラーです。

Excel VBA(Excel2000)について質問です。
セルの入力規則を設定するvalidationプロパティ設定時に表記エラーが起こるのですが、どういった原因なのか知りたいです。
そのエラーを起こす手順ですが、
1. 新規ブックを作成する
2. Visual Basic Editorを使用して、Sheet1に以下のコードを埋めこむ:

Private Sub Worksheet_Activate()
  With Cells(1, 1).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:="test1,test2"
  End With
End Sub

3. Sheet1 ←→ Sheet2 or Sheet3をタブで切り替える
  → 問題なく作動する
4. Sheet1の任意の場所に、コントロール ツールボックスのコマンドボタンを配置する
5. Sheet1 ←→ Sheet2 or Sheet3をタブで切り替える
  → これも問題なく作動する
6. 4.で配置したコマンドボタンを押す
7. Sheet1 ←→ Sheet2 or Sheet3をタブで切り替える
  → 表題のエラーが発生する

といったように、ボタンやチェックボックス等を配置したシートにおいてvalidation.addメソッドを使用すると、何故かエラーが発生します。この発生パターンが見つかるまでずっと悩んでいました。
今現在は、一応、他の方法で回避できてはいますが、どうしてこのエラーが出るのかはっきりしたいので、ご存知の方はどうぞご指導お願い致します。

Excel VBA(Excel2000)について質問です。
セルの入力規則を設定するvalidationプロパティ設定時に表記エラーが起こるのですが、どういった原因なのか知りたいです。
そのエラーを起こす手順ですが、
1. 新規ブックを作成する
2. Visual Basic Editorを使用して、Sheet1に以下のコードを埋めこむ:

Private Sub Worksheet_Activate()
  With Cells(1, 1).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:="test1,test2"
  End With
End Sub

3. Sheet1 ←→ Sheet2 or S...続きを読む

Aベストアンサー

> 6. 4.で配置したコマンドボタンを押す

この操作でコマンドボタンがアクティブ状態になってしまうのが原因のようですね。これはチェックボックスとかリストボックス等でも起こると思います。
最も簡単な対処方法としては、Cells(1,1).SelectとかRange("A1").SelectをWith Cells(1, 1).Validation の前に記述し、特定のセルをアクティブにする方法でしょう。

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

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外部データの更新がうまくできません(Excel VBA)

いつもお世話になってます。
以下のプログラムで外部データの更新を入れたのですがうまく作動しません。

Dim sh As Worksheet
Dim lr As Long
Dim tlr As Long

For Each sh In Worksheets
If sh.Name Like "*D" Then
sh.Select
Selection.QueryTable.Refresh
End If
Next

For Each sh In Worksheets
If sh.Name Like "*D" Then
lr = sh.Cells(Rows.Count, 5).End(xlUp).Row
sh.Rows("1:" & lr).Copy
tlr = Sheets("統合データ").Cells(Rows.Count, 5).End(xlUp).Row
Sheets("統合データ").Range("A" & tlr + 1).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Next

プログラムの内容としては
(1)末尾が"D "のシートのデータを更新する(これらのシートは外部データを取込んでいます)
(2)"*D"シートのデータを全て"統合データ"シートに上から順に貼り付ける
ですが、上のプログラムだともとあるデータを貼り付けてからデータを更新しています。更新後のデータを貼り付けるにはどのようにすればよいでしょうか。
よろしくお願いします。

いつもお世話になってます。
以下のプログラムで外部データの更新を入れたのですがうまく作動しません。

Dim sh As Worksheet
Dim lr As Long
Dim tlr As Long

For Each sh In Worksheets
If sh.Name Like "*D" Then
sh.Select
Selection.QueryTable.Refresh
End If
Next

For Each sh In Worksheets
If sh.Name Like "*D" Then
lr = sh.Cells(Rows.Count, 5).End(xlUp).Row
sh.Ro...続きを読む

Aベストアンサー

こんにちは。KenKen_SP です。

QueryTable はディフォルトでは非同期ですからね...更新前にどんどん先へ
コードを実行してしまいます。同期させたいなら、BackgroundQuery プロパティー
を False にしてください。

それから、Worksheets コレクションで同一のものを2度ループさせるさせる
のは冗長なので、一回で済ませましょう。

こんな感じでどうですか?

Sub SampleProc()

  Dim Sh     As Worksheet
  Dim QT     As QueryTable
  Dim lSrcLastRow As Long
  Dim lDstLastRow As Long
  
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name Like "*D" Then
      For Each QT In Sh.QueryTables
        ' 更新を待機するためには BackgroundQuery = True にします
        QT.BackgroundQuery = False
        QT.Refresh
      Next
      ' データコピー
      lSrcLastRow = Sh.Cells(Rows.Count, "E").End(xlUp).Row
      Sh.Rows("1:" & CStr(lSrcLastRow)).Copy
      ' データペースト
      With ThisWorkbook.Sheets("統合データ")
        lDstLastRow = .Cells(Rows.Count, "E").End(xlUp).Row
        .Rows(lDstLastRow + 1).PasteSpecial _
        Paste:=xlPasteValuesAndNumberFormats
      End With
    End If
  Next
  Application.CutCopyMode = False

End Sub

こんにちは。KenKen_SP です。

QueryTable はディフォルトでは非同期ですからね...更新前にどんどん先へ
コードを実行してしまいます。同期させたいなら、BackgroundQuery プロパティー
を False にしてください。

それから、Worksheets コレクションで同一のものを2度ループさせるさせる
のは冗長なので、一回で済ませましょう。

こんな感じでどうですか?

Sub SampleProc()

  Dim Sh     As Worksheet
  Dim QT     As QueryTable
  Dim lSrcLastRow As Long
  Dim lDs...続きを読む

QDoEvents関数って何?

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そこで「EXCEL VBA パーフェクトマスター」という本を見たら

for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
DoEvents
next i
unload userform1
と入力すれば解決することがわかりました。

しかし「DoEvents」についてあまり詳しく書いていなかったのでDoEvents関数をヘルプで見ると、
「発生したイベントがオペレーティング システムによって処理されるように、プログラムで占有していた制御をオペレーティング システムに渡すフロー制御関数です。」

と書いてあるのですが正直、書いてあることがよくわかりません。

どなたかDoEvents関数について、
もう少しわかりやすく教えていただけませんか。
それから、最初に書いたコードで実行すると
ユーザーフォームの背景が真っ白になってしまう原因も
教えていただけませんか?

よろしくお願いいたします。

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そ...続きを読む

Aベストアンサー

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
    DoEvents
    Cells(i,1) = ""
  Next i
End Sub

Private Sub CommandButton2_Click()
  MsgBox "hoge"
End Sub

っていうフォームのコードがあった場合、
DoEvents を入れることによって、ループ中にユーザーがCommandButton2 を押すことによって CommandButton2 のクリック イベントも動いちゃいます。
CommandButton1 のクリック イベントではループの前に
CommandButton1.Enabled = False
CommandButton2.Enabled = False
を書いてフォーム上の CommandButton を無効にしておき、ループが終わったら
CommandButton1.Enabled = True
CommandButton2.Enabled = True
と書いて CommandButton を有効に戻してください。

これを工夫すれば、CommandButton2 で CommandButton1 のループを途中キャンセルする処理もすることができます。

Private Canceled As Boolean

Private Sub CommandButton1_Click()

  CommandButton2.Enabled = False

  Dim i As Long
  For i = 1 To 50000
    DoEvents

    If Canceled = True Then
      MsgBox "キャンセルしました"
      Exit Sub
    End If

    Cells(i, 1).Value = ""
  Next i
End Sub

Private CommandButton2_Click()
  Canceled = True
End Sub



コードの行頭にあるスペースは見易さのために全角スペースで作成していますので、これをこのままコピペするとエラーになるかもしれません。
コピペするなら行頭の全角スペースを半角スペースに直してください。

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?


人気Q&Aランキング