{"id":2390,"date":"2022-05-26T12:15:08","date_gmt":"2022-05-26T03:15:08","guid":{"rendered":"http:\/\/oreoreki.gotdns.ch\/?p=2390"},"modified":"2022-06-02T18:48:26","modified_gmt":"2022-06-02T09:48:26","slug":"post-2390","status":"publish","type":"post","link":"http:\/\/oreoreki.gotdns.ch\/?p=2390","title":{"rendered":"ExcelVBA\u3067\u795d\u65e5\u3064\u304d\u4e88\u5b9a\u8868\u306e\u4f5c\u6210\u3057\u3066\u307f\u305f"},"content":{"rendered":"<p><span class=\"embed-youtube\" style=\"text-align:center; display: block;\"><iframe loading=\"lazy\" class=\"youtube-player\" width=\"750\" height=\"422\" src=\"https:\/\/www.youtube.com\/embed\/TbjYWauY8vM?version=3&#038;rel=1&#038;showsearch=0&#038;showinfo=1&#038;iv_load_policy=1&#038;fs=1&#038;hl=ja&#038;autohide=2&#038;wmode=transparent\" allowfullscreen=\"true\" style=\"border:0;\" sandbox=\"allow-scripts allow-same-origin allow-popups allow-presentation allow-popups-to-escape-sandbox\"><\/iframe><\/span><\/p>\n<div class=\"hcb_wrap\">\n<p>ExcelVBA\u3067\u795d\u65e5\u3064\u304d\u4e88\u5b9a\u8868\u306e\u4f5c\u6210\u3057\u3066\u307f\u305f<br \/>\n<span class=\"bold-red\">\u3053\u306e\u52d5\u753b\u306e\u30de\u30af\u30ed\u306fWindows11\/Office2013\u3067\u4f5c\u6210\u3057\u3066\u307e\u3059\u3002<br \/>\n<\/span><br \/>\n\u5185\u95a3\u5e9c\u3000\u300c\u56fd\u6c11\u306e\u795d\u65e5\u300d\u306b\u3064\u3044\u3066<br \/>\nhttps:\/\/www8.cao.go.jp\/chosei\/shukujitsu\/gaiyou.html<br \/>\n\u662d\u548c30\u5e74\uff081955\u5e74\uff09\u304b\u3089\u4ee4\u548c5\u5e74\uff082023\u5e74\uff09\u56fd\u6c11\u306e\u795d\u65e5\uff08csv\u5f62\u5f0f\uff1a20KB\uff09<br \/>\nhttps:\/\/www8.cao.go.jp\/chosei\/shukujitsu\/syukujitsu.csv<\/p>\n<h2><\/h2>\n<pre class=\"prism line-numbers lang-ts\" data-lang=\"TypeScript\"><code>Option Explicit\r\n\r\nSub Macro1()\r\n    Const org_r = 1       ' \u6a2a\u65b9\u5411\r\n    Const org_c = 2       ' \u7e26\u65b9\u5411\r\n    Const num_box = 2\r\n    Const sUrl = \"https:\/\/www8.cao.go.jp\/chosei\/shukujitsu\/syukujitsu.csv\"\r\n    '\u305d\u306e\u4ed6\u306e\u5909\u6570\u5ba3\u8a00\r\n    Dim this_year, xShukujitu, ws, ShukujitsuTBL, y, m, d, sLast, sLastDay, cell_date, cell_month, xlookup, x_date\r\n    \r\n   \r\n    ' \u4eca\u5e74\u306e\u5e74\u3092\u53d6\u5f97\r\n    this_year = Year(Date)\r\n    \r\n    Application.DisplayAlerts = False ' \u30e1\u30c3\u30bb\u30fc\u30b8\u3092\u975e\u8868\u793a\r\n    ' \u4eca\u5e74\u306e\u30b7\u30fc\u30c8\u306e\u4f5c\u6210\r\n    If ExistsSheet(Str(this_year)) Then Sheets(Str(this_year)).Delete\r\n    Sheets.Add After:=Sheets(Sheets.Count)\r\n    ActiveSheet.Name = Str(this_year)\r\n    ' \u6765\u5e74\u306e\u30b7\u30fc\u30c8\u306e\u4f5c\u6210\r\n    If ExistsSheet(Str(this_year + 1)) Then Sheets(Str(this_year + 1)).Delete\r\n    Sheets.Add After:=Sheets(Sheets.Count)\r\n    ActiveSheet.Name = Str(this_year + 1)\r\n    ' \u795d\u65e5\u30b7\u30fc\u30c8\u306e\u4f5c\u6210\r\n    xShukujitu = \"\u795d\u65e5\"\r\n    If ExistsSheet(xShukujitu) Then Sheets(xShukujitu).Delete\r\n    Sheets.Add After:=Sheets(Sheets.Count)\r\n    ActiveSheet.Name = xShukujitu\r\n\r\n  \r\n    ' \u30cd\u30c3\u30c8\u4e0a\u306e\u795d\u65e5\u30c7\u30fc\u30bf\u30fcCSV\u306e\u8aad\u307f\u8fbc\u307f\r\n    Set ws = ActiveSheet.QueryTables.Add(Connection:=\"TEXT;\" & sUrl, Destination:=Range(xShukujitu & \"!$A$1\"))\r\n        ws.TextFilePlatform = 932                               ' Shift_JIS \u3092\u958b\u304f\r\n        ws.TextFileStartRow = 1                                 ' 1 \u884c\u76ee\u304b\u3089\u8aad\u307f\u8fbc\u307f\r\n        ws.TextFileParseType = xlDelimited                      ' \u533a\u5207\u308a\u6587\u5b57\u306e\u5f62\u5f0f\r\n        ws.TextFileCommaDelimiter = True                        ' \u30ab\u30f3\u30de\u533a\u5207\u308a\r\n        ws.TextFileColumnDataTypes = Array(2, 2)                ' \u30c7\u30fc\u30bf\u30fc\u30bf\u30a4\u30d7\u3092\u6587\u5b57\u578b\u306b\u3059\u308b\r\n        \r\n    ws.Refresh BackgroundQuery:=False                           ' CSV\u53d6\u5f97\r\n    ShukujitsuTBL = ws.Name\r\n   \r\n    For y = this_year To this_year + 1\r\n        Sheets(Str(y)).Select\r\n        For m = 1 To 12\r\n            ' \u7fcc\u6708\uff11\u65e5\u306e\u524d\u65e5\u3092\u53d6\u5f97\r\n            sLast = DateSerial(y, m + 1, 0)\r\n            ' \u672b\u65e5\u306e\u65e5\u3092\u53d6\u5f97\r\n            sLastDay = Format(sLast, \"d\")\r\n\r\n            For d = 1 To sLastDay\r\n                Set cell_date = Cells(org_c + d, org_r + (m - 1) * (num_box + 1))   ' 1\u65e5\u76ee\u3092\u66f8\u304f\u30bb\u30eb\r\n                x_date = DateSerial(y, m, d)\r\n                cell_date.Value = x_date\r\n                cell_date.NumberFormatLocal = \"d\"\r\n                \r\n                ' \u795d\u65e5\u30c6\u30fc\u30d6\u30eb\u3092\u691c\u7d22\r\n                On Error Resume Next\r\n                xlookup = \"\"\r\n                xlookup = WorksheetFunction.VLookup(Format(x_date, \"yyyy\/m\/d\"), Sheets(xShukujitu).Range(ShukujitsuTBL), 2, False)\r\n                On Error GoTo 0\r\n                If xlookup <> \"\" Then\r\n                    ' \u795d\u65e5\u30c6\u30fc\u30d6\u30eb\u306b\u3042\u3063\u305f\uff01\r\n                    cell_date.Offset(0, 1).Value = xlookup\r\n                    cell_date.Font.Color = RGB(255, 0, 0)\r\n                End If\r\n                \r\n                Select Case Weekday(x_date)\r\n                Case 1  ' \u65e5\u66dc\r\n                    Range(cell_date, cell_date.Offset(0, num_box)).Interior.Color = RGB(255, 153, 204)\r\n                Case 7  ' \u571f\u66dc\r\n                    Range(cell_date, cell_date.Offset(0, num_box)).Interior.Color = RGB(0, 204, 255)\r\n                End Select\r\n            Next\r\n            \r\n            Set cell_month = Cells(org_c, org_r + (m - 1) * (num_box + 1))  ' \u6708\u306e\u540d\u524d\u3092\u66f8\u304f\u30bb\u30eb\r\n            cell_month.Value = m & \"\u6708\"\r\n            ' \u67a0\u7dda\u3092\u5f15\u304f\r\n            With Range(cell_month, cell_month.Offset(sLastDay, num_box))\r\n                .Borders.LineStyle = xlContinuous\r\n                .BorderAround Weight:=xlThick\r\n            End With\r\n        Next\r\n    Next\r\nEnd Sub\r\n\r\n' \u30b7\u30fc\u30c8\u306e\u5b58\u5728\u3092\u5224\u5b9a\u3059\u308b\u95a2\u6570\r\nPrivate Function ExistsSheet(ByVal bName As String)\r\n    Dim ws As Variant\r\n    ExistsSheet = False\r\n    For Each ws In Sheets\r\n        If LCase(ws.Name) = LCase(bName) Then\r\n            ExistsSheet = True ' \u5b58\u5728\u3057\u305f\r\n            Exit Function\r\n        End If\r\n    Next\r\nEnd Function\r\n\r\n<\/code><\/pre>\n<\/div>\n","protected":false},"excerpt":{"rendered":"<p>ExcelVBA\u3067\u795d\u65e5\u3064\u304d\u4e88\u5b9a\u8868\u306e\u4f5c\u6210\u3057\u3066\u307f\u305f \u3053\u306e\u52d5\u753b\u306e\u30de\u30af\u30ed\u306fWindows11\/Office2 [&hellip;]<\/p>\n","protected":false},"author":1,"featured_media":2392,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":true,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2}},"categories":[34],"tags":[],"class_list":["post-2390","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-vba"],"jetpack_publicize_connections":[],"jetpack_featured_media_url":"http:\/\/oreoreki.gotdns.ch\/wp-content\/uploads\/sites\/2\/2022\/05\/excelvba.jpg","jetpack_shortlink":"https:\/\/wp.me\/p9WqRX-Cy","jetpack_sharing_enabled":true,"_links":{"self":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts\/2390","targetHints":{"allow":["GET"]}}],"collection":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=2390"}],"version-history":[{"count":4,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts\/2390\/revisions"}],"predecessor-version":[{"id":2399,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts\/2390\/revisions\/2399"}],"wp:featuredmedia":[{"embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/media\/2392"}],"wp:attachment":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=2390"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=2390"},{"taxonomy":"post_tag","embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=2390"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}