こんにちは。

たびたびお世話になってます。
今、VBAでYahooファイナンスのサイトからWebクエリでシートに株価データを落として
手元にある、株価の入ったcsvファイルを更新する(新しいデータがあれば更新)マクロを
書いてるんですが、マクロ実行当初はまぁまぁの速さなのですが、株価データは大量に
あるため、3000銘柄くらいダウンロードすると、段々と速度が落ちてしまいます。

速度が落ちない良い方法はないでしょうか。
csvはエクセルでオープンしてます。Open文でcsvをテキストとして開いた方が
良いんでしょうか。。とりあえず、Webクエリの部分だけですが、ご教示お願いします。


Sub WebStockGet(ByVal httpUrl As String, ByRef testWs As Worksheet)

With testWs.QueryTables.Add(Connection:=httpUrl, Destination:=testWs.Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

End Sub

--
エクセル2003

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

A 回答 (1件)

このマクロはマクロの記録で[WEBクエリー]の動作を記録した物かと思いますが、基本的には余分なプオプション設定は必要ありません



参考URL
http://www.d3.dion.ne.jp/~jkondou/excelvba/T1.htm

不必要なオプションは全てカットするとすっきりします。

すっきりした所で本題に入りますが

読み込むテーブルのURL情報が
Connection:=httpUrl
となっているが実際に動作する場合は何処のデーターを読み込んでいますか?

オプションの中身を見ると読み込みするテーブルの選択が無いので
.WebTables =
WEBページ全体を一つのテーブルとして読み込んでいるようですが、不必要なデーターが一緒に付いてきていませんか?
Yahooファイナンスの株価データと言うと
http://stocks.finance.yahoo.co.jp/stocks/detail/ …
このページか
http://stocks.finance.yahoo.co.jp/stocks/history …
このページだと思いますが(共にYahooの株価)

ページ全体を一つのテーブルとして読み込み必要な情報だけ抜き出して整理する手法だと、クエリーのマクロ云々ではなくその後の処理内容の方を重視しないと実行速度の解決にはなりません

Yahooファイナンスでの株価情報は
http://table.yahoo.co.jp/t?s=4689.T&g=d
こちらのページからだと、必要な情報の日付を指定して株価データーを呼び出せます
URL指定をこんな形式にすると
http://table.yahoo.co.jp/t?c=2011&a=4&b=13&f=201 …
2011/4/13のデーターのみ取得することも可能で.WebTables =のオプションで必要なテーブルだけの抜き出しも可能です、その他のオプションの設定によっては過去のデーターに追加する形で付け加えることが可能なので、読み込み後のデーターの整理処理が必要なくなり、全体的な速度向上に繋がると思います。

必要とするのが終値でなく、リアルタイムの価格データーであれば
http://d.hatena.ne.jp/ken3memo/20090820/1250755545
こちらが参考になると思います
YouTubeでの詳しい解説もあるのでわかり易いと思います
    • good
    • 0

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

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

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

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

QVBAで、アクティブなBOOKのファイル名を取得し

エクセルのVBAを使用して、選択されている、BOOKのファイル名を取得し、下記のように編集してA1セルに入れたいのですが、可能でしょうか?


BOOKのファイル名が「大阪_たこ焼き_1234.xls」の場合

大阪_と.xlsをは省いて、「たこ焼き_1234」がA1セルに入るようにしたい。

Aベストアンサー

拡張子なんでもござれ!
Sub TheBody()
Const xSeparator = "_"
Const xPeriod = "."
Dim KitCut As Variant
KitCut = Split(ActiveWorkbook.Name, xPeriod)
KitCut = Split(KitCut(0), xSeparator)
Range("A1").Value = KitCut(1) & xSeparator & KitCut(2)
Columns("A").AutoFit
End Sub

Q条件付き書式で行全体の書式を変えたい。 こんにちは。VBA初心者です。 今、営業リストを作っています

条件付き書式で行全体の書式を変えたい。
こんにちは。VBA初心者です。
今、営業リストを作っていますが、条件付き書式で困っています。

A列はリストの通し番号です。B列に現時点の状況があり、C列以降は内容が記載されています。

B列の値を変えたら、行全体の文字色が変わるプログラムを作りたいと思っています。

B列はリストから選び、営業中(規定)、見積提出、受注、不調にしたときに色を変えたいです。
番号で管理しているため、どの行が変わるかはわからない状態です。

どなたか、お知恵を拝借したいと思います。
よろしくお願いいたします。

Aベストアンサー

こんなのはいかがですか?
---------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Select Case Target.Value
Case "営業中(規定)"
Rows(Target.Row).Font.ColorIndex = 3
Case "見積提出"
Rows(Target.Row).Font.ColorIndex = 4
Case "受注"
Rows(Target.Row).Font.ColorIndex = 5
Case "不調"
Rows(Target.Row).Font.ColorIndex = 6
Case Else
Rows(Target.Row).Font.ColorIndex = xlAutomatic
End Select
End Sub
---------------------------------------------------------------
※ 対象のシートモジュールに入力して下さい。
※「ColorIndex」の値はマクロの記録などで調べて変更してください。
とりあえず現状では以下にしてあります。
・営業中(規定)「3」赤
・見積提出「4」緑
・受注「5」青
・不調「6」黄
・その他「xlAutomatic」自動

こんなのはいかがですか?
---------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Select Case Target.Value
Case "営業中(規定)"
Rows(Target.Row).Font.ColorIndex = 3
Case "見積提出"
Rows(Target.Row).Font.ColorIndex = 4
Case "受注"
Rows(Target.Row).Font.ColorIndex = 5
Case "不調"
Rows(Target.Row).Font.ColorIndex = 6
Case Else
Row...続きを読む

QExcelVBA:自己のBook名を取得したい

WindowsXP-Proです。
Excelヴァージョンは2003です。

ExcelVBAでコーディングしています。
で、自分自身(つまり、このVBAコードを記述しているExcel本体)のBook名を取得したいのですが、何か関数は用意されていますでしょうか?

自分自身のBook名を取得したい理由は、VBAコードを記述しているExcel本体のファイル名(Book名)の名前が変更されても、VBAが正常に機能するように、今現在のBook名を取得したいのです。

複数のExcelファイルを、このVBAで操作しているため、
Workbooks("本体のBook名").Activate
を用いており、仮にファイル名(本体のBook名)の名前が変更されても、VBAが正常に機能できるように、"本体のBook名"部分を固定ではなく、可変で持てるようにしたいからです。

Aベストアンサー

Public Sub Auto_Open()
  MsgBox ActiveWorkbook.Name
  MsgBox ThisWorkbook.Name
End Sub

Private Sub Workbook_Open()
  MsgBox Me.Name
End Sub

いずれも、ブック名が表示されました。

QVBAでデータ更新作業自動化

エクセルで、シート1に顧客データ(会員番号、氏名、住所等)が有り、シート2の入力セルに会員番号を入力すると、シート1の顧客データがVLOOKUP関数により呼び出されるというエクセルファイルがあります。シート1の顧客データは、別システムでデータ更新しており、USBメモリにCSVファイルとして定期的に抽出しています。このCSVファイルのシート1の最新顧客データを元のエクセルファイルのシート1にすべてコピー&ペーストすることで最新の顧客データを更新しています。

このたび、その作業の自動化を図るにあたり、元のエクセルファイルのシート2で作成したボタンを押下することにより、自動実行したいのです。

お忙しいところ大変申し訳ないですが、そのような他ファイルに及ぶVBAの記述を教えていただけたらありがたいです。よろしくお願いします。

Aベストアンサー

どこで躓いているのか具体的にわかりませんが、他ファイルを開いて参照したい場合でも、やることは手作業ですることとほぼ同じです。

注意点が一つだけあって、「今アクティブなワークブックか」「今作業対象としたいワークブック/シートはどれか」というのをわかりやすくするための「目印」をつけることだけです。

以下のような感じだと思います。

'現在のブックと作業シート(Sheet1)をセット
Set MyBook = ActiveWorkbook
Set Mysheet = MyBook.Worksheets("Sheet1")

Set Acsheet = ActiveSheet: 'アクティブシート(=フォームのボタンがあるシート)

'CSVのブックと対象シートをセット。

Set SubBook = Workbooks.Open("C:\test.csv"): 'ファイル/ディレクトリはダミー
Set Subsheet = SubBook.Worksheets(1): 'CSVをExcelで開いた場合はシートは一つしかない=インデックスは1

'Sheet1のセルの値を全クリア
Mysheet.Cells.Clear

'CSVのデータをSheet1に全コピー
Subsheet.Cells.Copy Mysheet.Cells

'CSVを閉じる。
SubBook.Close

'ターゲットをボタンのあるシートに戻す。
Acsheet.Activate



以上ですが、テストはコピーしたファイルで行ってください。

どこで躓いているのか具体的にわかりませんが、他ファイルを開いて参照したい場合でも、やることは手作業ですることとほぼ同じです。

注意点が一つだけあって、「今アクティブなワークブックか」「今作業対象としたいワークブック/シートはどれか」というのをわかりやすくするための「目印」をつけることだけです。

以下のような感じだと思います。

'現在のブックと作業シート(Sheet1)をセット
Set MyBook = ActiveWorkbook
Set Mysheet = MyBook.Worksheets("Sheet1")

Set Acsheet = ActiveSheet: 'アクティ...続きを読む

Q他のワークシート名の取得方法 (VBAを使用せずに)

VBAを用いずに、ワークシート関数のみでワークシート名を取得できないか探しています。

自分のシート名は、以下の出力結果の一部より取得することができました。
=CELL("filename")

しかし、他のシート名を取得する方法が思いもつきません。

VBAを用いずにシート名を取得することはできないのでしょうか?

Aベストアンサー

Excel2000でしたら、
1.[挿入]-[名前]-[定義] から、名前を2つ定義します。
  ・名前:PPP  参照範囲:=GET.WORKBOOK(1)
  ・名前:QQQ  参照範囲:=GET.DOCUMENT(88)
2.A1 に =SUBSTITUTE(INDEX(PPP,ROW()),"["&QQQ&"]","") と入力します。
3.A1 を下方にドラッグコピーすると、シート名が一覧で表示されます。

例えば3枚目のシート名のみを取得する場合は、任意のセルに
=SUBSTITUTE(INDEX(PPP,3),"["&QQQ&"]","") と入力します。

※マクロ関数というものですが、最近のバージョンにこれが付帯されているのかどうか
  わかりませんが。   ^_^;

QExcel2003のVBAでデータリンクの更新をしない。

こんにちわ。
私はWindowsXPのExcel2003のVBAでCSVを読み込んでアンケートの結果を集計するマクロと、その結果を別のブックで保存するマクロを作成しました。2つのマクロがあるブックを閉じて、保存されたブックを開くと「このデータソースには他のリンクが設定されています」といったものが表示され、更新するかしないかを問われます。
そこで、このメッセージを表示しないでリンクの更新を行わないようにすることは可能でしょうか?

Aベストアンサー

2つのBook間で参照するセルがあるためだと思います。
集計の時に参照が残らないようにVBAを組むか、最後に参照元のあるシートに対して
Sheets("シート名").Cells.Copy
Sheets("シート名").Cells.PasteSpecial Paste:=xlValues
を行って、値のみにするなどの対処をすれば出なくなると思いいます。

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QVBAでエクセルのデータ更新 セルを合併したところへ

お世話になります
VBA(ACCESSの)でエクセルに更新したいのですが
普通のセルには、うまくいくのですが
合併したセルに対して更新できません
この場合何か方法がありますか、
何か手がかりだけでも、アドバイスいただけたら
と、思います
ちなみに、codingは
一行目のRow Columで、行列を指定して"data"と
いうデータを更新するところ
xls.Application.Goto "r" & x & "c" & y
xls.Application.Activecell.Value = "data"

Aベストアンサー

こんにちは。

Access のデータをExcelに、オートメーションオブジェクトか何かで、データを貼り付けるのでしょうか?全体がどうなっているのか、さっぱり見当が付きません。

Goto でセルを選択した後は、どうするのでしょうか?データは?
xls.Application.Goto Sheet1.Range("A1")
としてもよいけれども、オブジェクトの処理でしたら必要ないのではありませんか?

>xls.Application.Activecell.Value = "data"
それに、これでは分らないです。

単に、オートメーション・オブジェクトのExcel.Application を、例えば、xlAppの変数に入れたら、後は、ブックを開けて、以下のようにしたら進んでいくはずです。

With xlApp.myBook1.Sheet1
  For i = 1 To 100
   If .Cells(i, 1).MergeCells Then
    '結合セル処理
   Else
   '通常のセルの処理
   End If
  Next
 End With

こんにちは。

Access のデータをExcelに、オートメーションオブジェクトか何かで、データを貼り付けるのでしょうか?全体がどうなっているのか、さっぱり見当が付きません。

Goto でセルを選択した後は、どうするのでしょうか?データは?
xls.Application.Goto Sheet1.Range("A1")
としてもよいけれども、オブジェクトの処理でしたら必要ないのではありませんか?

>xls.Application.Activecell.Value = "data"
それに、これでは分らないです。

単に、オートメーション・オブジェクトのExcel.Appl...続きを読む

QVBAでアカウント名を取得する方法

VBAで処理したEXCELブックをデスクトップに自動保存しようとしています。VBAで現在作業中のユーザーアカウント名を自動で取得する方法を教えていただきたいのですが。

デスクトップ上にブックを保存するには、パスを記述すればよいのですが、現在PC毎にユーザーアカウントを設定しユーザー名が異なっています。
このため、PC毎にこのユーザー名をデスクトップへのパスに入れ込まなければなりません。毎回キーボードからこのユーザー名を入力する方法もありますが、自動的にユーザー名を取得し、正しいパスを指定する方法を検討しています。
どなたか、VBAでこのユーザー名を取得する方法が有れば教えていただきたいのですが。
よろしくお願いいたします。

Aベストアンサー

Environ関数で、環境変数[USERNAME]を取得する。

MsgBox Environ("USERNAME")

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...続きを読む


人気Q&Aランキング

おすすめ情報