teacup. [ 掲示板 ] [ 掲示板作成 ] [ 有料掲示板 ] [ ブログ ]

 投稿者
  題名
  内容 入力補助画像・ファイル<IMG>タグが利用可能です。(詳細)
    
 URL
[ ケータイで使う ] [ BBSティッカー ] [ 書込み通知 ] [ 検索 ]

スレッド一覧

  1. 足あと帳(0)
スレッド一覧(全1)  他のスレッドを探す 

*掲示板をお持ちでない方へ、まずは掲示板を作成しましょう。無料掲示板作成


(無題)

 投稿者:test  投稿日:2011年10月14日(金)23時37分18秒
返信・引用
  tesxt  
 

(無題)

 投稿者:test  投稿日:2011年10月14日(金)23時34分31秒
返信・引用
  text  

(無題)

 投稿者:test  投稿日:2011年10月11日(火)23時22分16秒
返信・引用
  Option Explicit
'メイン関数
Sub CreateTweet()

Dim tommorow As Date   '明日の日付

'明日の日付を取得
tommorow = Date + 1

WebQueryRefresh (tommorow)
DateTimeSort
'CreateBlankSheet (tommorow)
CopyItem (tommorow)

End Sub

'WEBクエリを更新とHTMLソース
Sub WebQueryRefresh(tommorow As Date)

Dim Y, M As String   '現在の年月
Dim URL As String   '取り込み先URL
Dim i, j As Integer 'ループカウンタ
Dim objIE As Object  'IEオブジェクト参照用
Dim time10 As Date  '時刻格納用
Dim strHTML, strHTML2 As String  'HTMLソース格納用

'日付から年月を抜き出す
Y = Year(tommorow)
M = month(tommorow)

'経済指標のURLの末尾に年月を結合させる
URL = "URL;http://fx.inet-sec.com/market/calendar/economy_forecast/yearMonth_" & Y & M

'WEBクエリ取得シートをクリアする
Sheets("指標").Cells.Value = ""

'WEBクエリの更新
With Sheets("指標").QueryTables.Add(Connection:= _
    URL _
    , Destination:=Sheets("指標").Range("$E$1"))
    .Name = "yearMonth_201110"
    .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

'HTMLソースの取得
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)

'INET経済指標のページに飛ぶ
objIE.Navigate "http://fx.inet-sec.com/market/calendar/economy_forecast/yearMonth_" & Y & M

'表示されるまで待つ、10秒後にエラーを判断する
time10 = DateAdd("s", 10, Now())  '現在から10秒後を計算
Do While objIE.Busy = True   'ビジー、読み込み中の間
    DoEvents
    If time10 < Now() Then   '10秒経過したか?
        MsgBox "タイムアウトです"
        Exit Sub
    End If
Loop

'HTMLソースを取出す
strHTML = objIE.document.body.innerHTML  '変数に代入
'MsgBox strHTML       'テスト表示
'Debug.Print strHTML  'イミディエイトにも表示
'Sheets("指標").Range("D1") = strHTML

'IEを閉じる
objIE.Quit


'作成対象の日付が月末の場合
If day(tommorow + 1) = 1 Then

'ループカウンタをセットする
i = 1


Do
    'A~Fのセルが全て空白
    For j = 5 To 11
        If (Sheets("指標").Cells(i, j) <> "") Then Exit For
    Next

    'A~Fのセルが全て空白ならばループを抜ける
    If j > 10 Then Exit Do

    i = i + 1
Loop

'翌月の年月を格納する
Y = Year(tommorow)
M = month(tommorow) + 1

'経済指標のURLの末尾に年月を結合させる
URL = "URL;http://fx.inet-sec.com/market/calendar/economy_forecast/yearMonth_" & Y & M

'WEBクエリの更新
With Sheets("指標").QueryTables.Add(Connection:= _
    URL _
    , Destination:=Sheets("指標").Cells(i, 5))
    .Name = "yearMonth_201110"
    .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

'HTMLソースの取得
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)

'INET経済指標のページに飛ぶ
objIE.Navigate "http://fx.inet-sec.com/market/calendar/economy_forecast/yearMonth_" & Y & M

'表示されるまで待つ、10秒後にエラーを判断する
time10 = DateAdd("s", 10, Now())  '現在から10秒後を計算
Do While objIE.Busy = True   'ビジー、読み込み中の間
    DoEvents
    If time10 < Now() Then   '10秒経過したか?
        MsgBox "タイムアウトです"
        Exit Sub
    End If
Loop

'HTMLソースを取出す
strHTML2 = objIE.document.body.innerHTML  '変数に代入
'MsgBox strHTML       'テスト表示
'Debug.Print strHTML  'イミディエイトにも表示

'IEを閉じる
objIE.Quit

End If

End Sub


'日時でソートする
Sub DateTimeSort()

Dim i, j As Integer 'ループカウンタ
Dim YMD As Date   '年月日

'ループカウンタをセット
i = 1

'データが空白の行までループ
Do
    'A~Fのセルが全て空白
    For j = 5 To 11
        If (Sheets("指標").Cells(i, j) <> "") Then Exit For
    Next

    'A~Fのセルが全て空白ならばループを抜ける
    If j > 10 Then Exit Do

    '1列目のセルが日付なら日付を変数に格納
    If IsDate(Sheets("指標").Cells(i, 5)) Then YMD = Sheets("指標").Cells(i, 5)

    'セルのフォーマットを変更
    Sheets("指標").Cells(i, 6) = Format(Sheets("指標").Cells(i, 6), "hh:mm")

    'セルの表示形式を変更
    Sheets("指標").Cells(i, 6).NumberFormatLocal = "yyyy/m/d h:mm;@"

    '日付と時間を結合させる
    If IsDate(Sheets("指標").Cells(i, 6)) Then Sheets("指標").Cells(i, 6) = YMD + Sheets("指標").Cells(i, 6)

    i = i + 1
Loop

'日時でソートする
Sheets("指標").Sort.SortFields.Clear
Sheets("指標").Sort.SortFields.Add Key:=Range("F1:F326"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets("指標").Sort
    .SetRange Range("E1:J326")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

End Sub

'空のシートを作成する
Sub CreateBlankSheet(tommorow As Date)

Dim YMD As String   '現在の年月

'日付から年月日を抜き出す
YMD = Year(tommorow) & month(tommorow) & day(tommorow)

'新書用シートをコピーする
Sheets("新書用").Copy After:=Sheets("指標")

'シートを年月日でリネームする
Sheets("新書用 (2)").Name = YMD

End Sub

Sub CopyItem(tommorow As Date)

Dim i, j As Integer 'ループカウンタ
Dim all_num As Integer '全体の通し番号
Dim zone_num As Integer '時間帯別番号

'ループカウンタをセット
i = 1

'時間帯別番号をセット
zone_num = 1

'データが空白の行までループ
Do
    'A~Fのセルが全て空白
    For j = 5 To 11
        If (Sheets("指標").Cells(i, j) <> "") Then Exit For
    Next

    'A~Fのセルが全て空白ならばループを抜ける
    If j > 10 Then Exit Do



    Select Case Sheets("指標").Cells(i, 6)
        Case tommorow + CDate("00:01") To tommorow + CDate("3:00")

        Case tommorow + CDate("03:01") To tommorow + CDate("6:00")

        Case tommorow + CDate("06:01") To tommorow + CDate("9:00")

        Case tommorow + CDate("09:01") To tommorow + CDate("12:00")

        Case tommorow + CDate("12:01") To tommorow + CDate("15:00")

        Case tommorow + CDate("15:01") To tommorow + CDate("18:00")

        Case tommorow + CDate("18:01") To tommorow + CDate("21:00")

        Case tommorow + CDate("21:01") To tommorow + 1


        Case Else
    End Select

    i = i + 1
Loop

End Sub


 

掲示板が完成しましたキラキラ

 投稿者:teacup.運営  投稿日:2011年10月11日(火)11時54分6秒
返信・引用
  ご利用ありがとうございます。

teacup.掲示板は
ダイヤスレッド作り放題右上
ダイヤ画像・動画・音楽の投稿OK
ダイヤケータイ絵文字が使えるv▽v
ダイヤRSS対応ヒラメイタ!
ダイヤお絵描き機能付きえんぴつ
ダイヤかわいいケータイテンプレハートx2

足跡足あと帳はコチラ
スレッド内容は管理画面内「スレッドの管理」から編集できます。
 

レンタル掲示板
/1