[[20200919222758]] 『WebAPIを使用を判定し日付変換』(吉信) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『WebAPIを使用を判定し日付変換』(吉信)

inputBOXで範囲選択しても日付が出ません 原因解明ができませんお助けを!!
Option Explicit
'日付入力
Private Sub CommandButton1_Click()

    Dim tmp As String

    'キャンセルが押された場合は処理を終了する
    On Error GoTo myError
    tmp = Application.InputBox("列を選択して下さい", "列の選択", Type:=8).Address
    On Error GoTo 0

    Dim monthStart As Long  '月初の日付
    Dim monthEnd As Long    '月末の日付

    monthStart = 1
    monthEnd = Day(DateSerial(Year(Date), Month(Date) + 1, 0))

    Range(tmp).Select

    Dim y As Long
    Dim x As Long
    Dim col As Long '選択した列番号
    Dim row As Long '選択した行番号
    Dim strYear As String
    Dim strMonth As String
    Dim strDay As String
    Dim activeDate As String
    Dim activeDateFmat As String

    Dim apiUrL As String    'apiのURL
    apiUrL = "http://s-proj.com/utils/checkHoliday.php?kind=h&date="

    '列が選択されていた場合
    If Selection.Address = Selection.EntireColumn.Address Then

            col = Selection.Column

            For y = monthStart To monthEnd
                Cells(y, col).Value = y

                strYear = Year(Date)
                strMonth = Month(Date)
                strDay = y
                activeDate = strYear & "/" & strMonth & "/" & strDay
                '日付の区切りを取り除く
                activeDateFmat = Format(activeDate, "yyyymmdd")

                '日付から曜日の数値を取得
                tmp = Weekday(activeDate)
                '曜日の数値から曜日を取得(Trueで曜日名を省略)
                tmp = WeekdayName(tmp, True)
                '日付の隣のセルに曜日を入れる
                Cells(y, col + 1).Value = tmp

                '休日か祝日の場合は日付を赤色にする
                If CheckHoliday(apiUrL & activeDateFmat) = "holiday" Then
                     Cells(y, col).Font.ColorIndex = 3
                End If
            Next

    Else
        '行が選択されていた場合
        If Selection.Address = Selection.EntireRow.Address Then

            row = Selection.row

            For x = monthStart To monthEnd
                Cells(row, x).Value = x

                strYear = Year(Date)
                strMonth = Month(Date)
                strDay = x
                activeDate = strYear & "/" & strMonth & "/" & strDay
                '日付の区切りを取り除く
                activeDateFmat = Format(activeDate, "yyyymmdd")

                '日付から曜日の数値を取得
                tmp = Weekday(activeDate)
                '曜日の数値から曜日を取得(Trueで曜日名を省略)
                tmp = WeekdayName(tmp, True)
                '日付の隣のセルに曜日を入れる
                Cells(row + 1, x).Value = tmp

                '休日か祝日の場合は日付を赤色にする
                If CheckHoliday(apiUrL & activeDateFmat) = "holiday" Then
                     Cells(row, x).Font.ColorIndex = 3
                End If
            Next
        End If
    End If

myError:

End Sub

'祝休日の判定
Function CheckHoliday(ByVal apiUrLAddPra As String)

    'XMLHttpRequestオブジェクトを作成
    Dim HttpReq As Object
    Set HttpReq = CreateObject("MSXML2.XMLHTTP")

    HttpReq.Open "GET", apiUrLAddPra, False
    HttpReq.send (Null)

    '戻り値(祝休日の場合holiday、それ以外はelseを返す)
    CheckHoliday = HttpReq.responseText

    Set HttpReq = Nothing

End Function

< 使用 Excel:Excel2019、使用 OS:Windows10 >


行や列をまとめて選択していないからじゃないですか?

ところで、これはあなたが書いたものではないでしょう?
出典を明記されたほうがよいと思います。

(γ) 2020/09/19(土) 22:56


本当に申し訳ありませんでした。出典サイトのURLは
エクセルVBAでWebAPIを使って祝日を判定する方法【日付変換】https://asatte.biz/check-holiday/
あつもり先生のぶんです。私のPC Excelにコードをコピーさせていただきましたが、今月の日付と曜日が全然出てきません何が原因でしょうか?行や列をまとめて選択しても選択範囲が黒くなるだけで日付も曜日も何も出てこないです。お力添えをお願い致します。本当にルール違反行為ました申し訳ありませんでした。
(吉信) 2020/09/20(日) 06:51

ああ、そんなに深刻な話でも無いので、気になさらず。
出典は了解しました。

ところで、
Inputboxが出たときに、どうされています?
列であれば、例えば「B」という列文字が表示されている部分をクリックして、
Inputbox内の表示が
  $B:$B 
となっていますか?
ひょっとして、B1:B30などを選択していないかと思ったまでです。

ステップ実行して、自分の想定している動きからはずれるところはどこか、確認して下さい。

私の手元では正常動作しています。
あとは環境ですけど。(参照設定せよと書いてあるが、別にしなくても動作はしますね)
とりあえず、上記の点、もう一度確認します。

(γ) 2020/09/20(日) 07:10


$B:$B 
となっています ステップ実行のやり方がよくわかりません教えてください
(吉信) 2020/09/20(日) 07:58

一行づつ ステップ実行してやっていくとInputboxで選択範囲を指定しONボタンをおしたらそこまで終わってるようですが?それからが黄色いラインマーカーがなくなってます。
(吉信) 2020/09/20(日) 08:08

>On Error GoTo 0
の次の行に
STOP
を挿入して下さい。
 
そこで確実に止まる筈ですから、
その後、F8キーを押しながらステップ実行してください。

# 手元のExcel2010,2019いずれでも成功していますから
# ちょっとした手違いだろうと思います。
(γ) 2020/09/20(日) 08:30


STOPと入力でしょうか
(吉信) 2020/09/20(日) 08:38

最後までステップ実行はでき変数等も確認しましたが、間違いありませんでしが同じ状態
(吉信) 2020/09/20(日) 08:43

    '列が選択されていた場合
    If Selection.Address = Selection.EntireColumn.Address Then
            col = Selection.Column
            For y = monthStart To monthEnd
                Cells(y, col).Value = y
  では、最初の分岐はどちらに実行が移って行きましたか?
            col = Selection.Column
    や、次のFor文は実行されましたか?

                Cells(y, col).Value = y
    が実行されると、アクティブシートに  日が書き込まれるはずですね。
    ステップ実行したなら、そのあたりを確認して返事して下さい。

(γ) 2020/09/20(日) 08:51


ステップ実行ができていれば、
Cells(y, col).Value = y (日を書き込む)

Cells(y, col + 1).Value = tmp (曜日を書き込む)
などが、なぜ実行されないのか、
または、
実行されたが、想定したものと異なるものが書き込まれたか、
確認できるはずですよね。

祝休日であるかどうかをサイトに照会するところ以前の問題なので、
頑張って下さい。
(γ) 2020/09/20(日) 09:02


 あつもり先生本人が使う分にはそれでいいんでしょうが、
 使いにくくないですかね。

 元になる日付データ(yyyy/m/d)も、単なる日(d)に変えられちゃいます。
 列全体とか行全体とかを選択する方式って、首を傾げたくなります。
 日付の処理も回りくどい印象があります。

 吉信さん自身の表で、どこに何をしたら、どういう日が出て欲しいのか、
 その説明をして頂く方が無駄がないような気がします。

 あと、どこで休日を取って来るのか面倒なのでチェックしてないですが、
 自社で使う休日と完全合致しているんですか?

 ※通常、そんなラッキーな事ってないと思うんですが。

(半平太) 2020/09/20(日) 15:37


まったく同感ですね。
国民の祝日は国が定めていて、もっと信頼できるところにソースがあるでしょうね。(ソースは内閣府のデータのよう)
それにそう何回も作る必要ないわけですから、ネットで問い合わせするほどのことでも
ないでしょうね。
まあ、何が便利と思うかは温度差があるのかもしれませんが。

       For y = monthStart To monthEnd
            Cells(y, col).Value = y
            d = DateSerial(Year(Date), Month(Date), y)
            tmp = Format(d, "aaa")          '曜日(月,火等)
            Cells(y, col + 1).Value = tmp

            '休日か祝日の場合は日付を赤色にする
            activeDateFmat = Format(d, "yyyymmdd")
            If CheckHoliday(apiUrL & activeDateFmat) = "holiday" Then
                Cells(y, col).Font.ColorIndex = 3
            End If
        Next
みたいな書き方をしそうですね。

また、
HttpReq.send (Null)
というのも少し違和感がありました。
無指定のデフォルトで Nullになりますから、
敢えて書かないことのほうが多いように思います。
たしかVariant型を渡すので、あえてカッコをつけているんでしょうけど、
その辺も間違いのもとになるので、書かない方が無難だと思います。

それはそうと質問者さんは解決されたのでしょうか。

(γ) 2020/09/20(日) 16:51


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.