質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.96%

VBA マクロ を使って、毎日のデータ更新をしたいです

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 3,155

score 16

前提・実現したいこと

一、開催場所別にシートを分けているので、それぞれ会場のシートに12レース分表示したい(A1セル、E1セル...と順に横にずれてほしいです)。
一、開催場所でレースがない場合は、webサイト自体ない(エラーが起きる)のでその時はA1セルに本日のレースはありませんと表示したい

発生している問題・エラーメッセージ

初日の日を何とかwebサイトから落として表示できるようになったのですが、つぎはマクロがなぜかエラーが起きるようになってしまいました
↓このような感じです
http://iup.2ch-library.com/i/i1656034-1464896090.png

該当のソースコード

Sub 桐生(Lng_日付 As Long, Lng_場 As Long, Lng_初日 As Long)

    Dim Str_アドレス As String

    Sheet 桐生.Select
    Cells.Delete Shift:=xlUp
    For Lng_レース = 1 To 12

        Str_アドレス = "FINDER;http://app.boatrace.jp/race/" & Format(Lng_場, "00")
        Str_アドレス = Str_アドレス & "_" & Format(Lng_初日, "yyyymmdd")
        Str_アドレス = Str_アドレス & ".php?day=" & Format(Lng_日付, "yyyymmdd")
        Str_アドレス = Str_アドレス & "&jyo=" & Format(Lng_場, "00")
        Str_アドレス = Str_アドレス & "&rno=" & Format(Lng_レース, "00") & "&type=program"

        Dim str_列 As String
        If Lng_レース < 8 Then
             str_列 = Chr(Asc("A") + (Lng_レース - 1) * 4)
        Else
             str_列 = "A" & Chr(Asc("A") + ((Lng_レース - 1) * 4) - 26)
        End If

        Dim Lng_列 As Long
        Lng_列 = ((Lng_レース - 1) * 4) + 1

        Dim rng_出力 As Range
        Set rng_出力 = Range(Cells(1, Lng_列))

        With ActiveSheet.QueryTables.Add(Connection:=Str_アドレス, Destination:=rng_出力)
            .Name = "Data"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    Next
End Sub

試したこと

jawaさんが書いてくださったマクロを元に初日をC3セルから取り込むようにしようとしたのですが、勝手にマクロを書き換えたせいか、できなくなりました。

補足情報(言語/FW/ツール等のバージョンなど)

EXCEL 2010 を使ってます。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • jawa

    2016/06/02 18:44

    イメージ説明が見えないので修正をお願いしますm(__)m

    キャンセル

  • sugerShogo

    2016/06/03 04:39

    なぜか画像が張り付けれないので、http://iup.2ch-library.com/i/i1656034-1464896090.pngで宜しくお願い致します。

    キャンセル

回答 2

checkベストアンサー

+1

質問する上でいくつか大事なことが端折られています。
まず、
>いろいろ試したがVBA初心者なので全滅でした。
「いろいろ」といわれても何をどれほどやったのか伝わりません。ここ大事です。
さらに提示のソースコードは「人に作ってもらったもの」で「その人には修正を頼めないからここで教えてほしい。」のでは、自分では何もせず丸投げしていると取られても仕方ありません。
たぶん自分でも努力されているのでしょうけど、その説明を省いてしまってはこの結果になります。

次に、やりたいことの細かい部分は書いてくれているのに、その背景が説明されていません。
まずベースとなるデータはどんな内容ですか?(どういう単位で取得でき、どんな内容が含まれていますか?)
困っていることもしっかり書いてくれていますが、この説明がないので「今日のデータ」とか「初日が」とか言われてもさっぱり伝わりません。

提示のソースコードやコード中のURLから解析すればアドバイスもできるかもしれませんが、まずは質問者さんの言葉でもう少し補足をお願いしたいです。

よろしくお願いします。


返信コメントを受けて追記

単位というのは、データを取得できる単位のことです。

データを取得するために、URLとして会場番号・開始日・日付・レースNOが必要ということなので、これが単位ですね。
取得できるデータも、指定した会場番号・開始日・日付・レースNOに関する情報が取れるはずです。
(この指定方法だと複数会場とか複数日付を同時に取得することはできないので、会場番号・開始日・日付・レースNO単位の取得、というわけです。)

内容というのは、取得できるデータの内容です。そのままですね(^-^;
おそらくそのレースに出場する人とか、スタート位置とか、モーターの情報とかが取得できているのでしょうが、ソースを見る限り今回はあまり触れなくていいのかもしれません。


>どうやって開始日を自動で検索しているのか
tnd-.-bさんも詳しく説明してくれていますが、Weekdayは指定した日付が何番目の曜日かを返す関数です。
今回は火曜日を基準に指定しているので、火曜日が1、水が2、木が3・・・月が7となります。

これを踏まえて、

Day_初日 = Day_日付 - Weekday(Day_日付, vbTuesday) + 1


の式は Day_初日 には Day_日付の直前の火曜日を返す式ということになります。

私もボートには詳しくありませんが、開始日に規則性がないのであれば都度手入力してあげるか、別途カレンダーデータを用意してあげて検索することになると思います。
基本的に会場毎に基準となる曜日でもあれば(江戸川は火曜日、浜松は月曜日など)、コードで計算できるのですが。


以下、ここまでの情報からやりたそうなことを形にしてみました。動作未確認ですが参考までに。

Sub データ抽出(Day_日付 As Date, Lng_場 As Long)

    Dim Str_アドレス As String
    Dim Day_初日 As Date

    '会場ごとに基準の曜日を変更
    Dim Week_基準 As VbDayOfWeek

    Select Case Lng_場
    Case 3
        '江戸川:火曜
        Week_基準 = vbTuesday

    '(ここに他会場の基準曜日も設定する)

    Case Else
        'どれにも該当しなければ日曜を基準
        Week_基準 = vbSunday

    End Select

    Day_初日 = Day_日付 - Weekday(Day_日付, Week_基準) + 1

    Sheet1.Select
    Cells.Delete Shift:=xlUp

    'レース番号は引数取得ではなくループ処理にする
    For Lng_レース = 1 To 12

        Str_アドレス = "FINDER;http://app.boatrace.jp/race/" & Format(Lng_場, "00")
        Str_アドレス = Str_アドレス & "_" & Format(Day_初日, "yyyymmdd")
        Str_アドレス = Str_アドレス & ".php?day=" & Format(Day_日付, "yyyymmdd")
        Str_アドレス = Str_アドレス & "&jyo=" & Format(Lng_場, "00")
        Str_アドレス = Str_アドレス & "&rno=" & Format(Lng_レース, "00") & "&type=program"

        'Dim str_列 As String
        'If Lng_レース < 8 Then
        '    str_列 = Chr(Asc("A") + (Lng_レース - 1) * 4)
        'Else
        '    str_列 = "A" & Chr(Asc("A") + ((Lng_レース - 1) * 4) - 26)
        'End If

        Dim Lng_列 As Long
        Lng_列 = ((Lng_レース - 1) * 4) + 1

        Dim rng_出力 As Range
        Set rng_出力 = Range(Cells(1, Lng_列))

        With ActiveSheet.QueryTables.Add(Connection:=Str_アドレス, Destination:=rng_出力)
            .Name = "Data"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    Next
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/06/03 09:42

    (エラーメッセージの内容が記載されていないので推測になりますが)
    今回エラーとなっているのは、「型が一致しません」というエラーが出ているのではないかと思います。

    質問文に記載いただいている関数を呼び出す側の処理で、Range.Valueを引数として渡していますね。

    受け取る側の関数では引数をLong型で宣言しているので、Long型として扱えるセル内容であれば問題ありません。
    例えば、数値はもちろんOK、日付もシリアル値で受け取れます。

    ややこしいのが、未入力のセル(Nothing)と空文字列(Empty)のセルです。
    未入力のセルとは、値が全く入っていないセル(セルの初期状態や、DELETEキーで値を消した状態)です。
    空文字列のセルとは、空の文字列("")が入力されているセルです。見た目ではわかりませんが、式を埋め込んであり結果が空の場合などがこれに当たります。

    未入力セルは暗黙的に0値に変換されて受け取れますが、空文字列のセルは暗黙的に数値に変換することができません。

    このため、「もらった引数はそのままではLong型に変換できなかったよ」という意味で「型が一致しません」というエラーが発生しているのだと思います。

    対策ですが、引数でエラーにならないようにしたいだけならRange.ValueをVal(Range.Value)にしてあげれば0値として渡すことができるようになります。
    しかし、今回の場合はそもそも桐生の初日が未入力だということが問題なのではないかと思います。
    初日が記載されていない場合はどうするのか、
     ・そんな会場は無視する
     ・当日を初日とする
     ・暫定で今週の火曜日を初日にする
    などなど、ここはコーディングではなく仕様部分の検討になりますね。

    頑張ってみてください。

    キャンセル

  • 2016/06/03 11:32

    書いてある内容を6割ほど(用語など)理解できない人間なので、自力で作るのは、ほぼあきらめています。
    貰ったデータに自分がしたいことを入れては消しての繰り返しです、、、勉強になるからいいんですけどね!
    質問を新しくしてほかの人に聞いてみます!ありがとうございました!

    キャンセル

  • 2016/06/03 12:26 編集

    長くてわかりにくい説明になってしまったようで申し訳ありません。

    言いたかったことを簡単にまとめると、
     ・エラーが発生しているのは数値にできない値を数値にしようとしているからで、
      回避するにはVal関数が使えます。
     ・初日のセルが空の場合にエラーが発生しているので、初日が取れない(開催日がない)
      会場をどう処理したいのかを決めましょう。
    という2点です。

    >自力で作るのは、ほぼあきらめています。
    ここまで少しずつでもご自分でロジックに手を加えながら悪戦苦闘しながら努力されているので大丈夫だと思いますが、一応ここは技術者のための情報交換サイトです。

    そのスタンスで新しい質問を投げたら、ここでは叩かれてしまいますのでご注意ください。

    あきらめず少しずつでもがんばってくださいね。
    目的が達成されることをお祈りいたします。

    キャンセル

+1

競艇はモン◯ーターンという漫画でしか知らないですけど、相手がプログラムなら多少わかります。

レースの開始日の計算が正しくありません。

Dim Day_初日 As Date
Day_初日 = Day_日付 - Weekday(Day_日付, vbTuesday) + 1

WeekDayは「第一引数に与えた日付が一週間の何日目か」を得る関数です。
第二引数は「週の頭の曜日」で、ここに与えた曜日を1として数えます。

従って、上記コードは
「火曜日を始まり(1)とした場合に、Day_日付は何日目?」
を得ることになります。

Day_日付=今日(6/1 水)と考えると、weekday=2(火曜日が1、水曜日が2)で、
Day_初日は 6/1 - 2(day) + 1(day) で、5/31 となります。
BOATBoyカップは5/29が初日みたいなので、これだと取れないですね。

直感ですが、計算で「カップの開始日」を得るのは無理なんじゃないかと思います。
公式ページを眺めても規則が見いだせないので。手入力とするのがよろしいかと。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/06/01 15:09

    分かりやすいご回答ありがとうございます!
    モンキ○ターン面白いですよね!すごく好きです!笑

    >Day_日付=今日(6/1 水)と考えると、weekday=2(火曜日が1、水曜日が2)で、
    Day_初日は 6/1 - 2(day) + 1(day) で、5/31 となります。
    BOATBoyカップは5/29が初日みたいなので、これだと取れないですね。

    なるほどです...
    http://app.boatrace.jp/race/monthly/
    ここに月の予定表があるのですが、こちらも表なのでここから初日だけを切り取る方法も難しいですよね,,,?やはり手入力しかないでしょうか?

    キャンセル

  • 2016/06/01 15:17

    http://app.boatrace.jp/race/monthly/
    ここに月の予定表があるのですが、こちらも表なのでここから初日だけを切り取る方法も難しいですよね,,,?やはり手入力しかないでしょうか?

    すみません!ここの問題自分でも解決できそうです!

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.96%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る