{"id":1688,"date":"2017-07-13T07:48:16","date_gmt":"2017-07-12T22:48:16","guid":{"rendered":"http:\/\/okamurax.com\/?p=1688"},"modified":"2017-07-13T07:48:16","modified_gmt":"2017-07-12T22:48:16","slug":"vba-%e5%a4%96%e6%b3%a8%e7%ae%a1%e7%90%86%e7%94%a8%e5%b7%a5%e7%a8%8b%e3%83%81%e3%83%a3%e3%83%bc%e3%83%88%e4%bd%9c%e6%88%90%e6%a9%9f%e8%83%bd","status":"publish","type":"post","link":"https:\/\/appbay.org\/?p=1688","title":{"rendered":"VBA \u5916\u6ce8\u7ba1\u7406\u7528\u5de5\u7a0b\u30c1\u30e3\u30fc\u30c8\u4f5c\u6210\u6a5f\u80fd"},"content":{"rendered":"<p>\u5217\u6570\u304c\u591a\u304f\u306a\u308b\u3068\u7ba1\u7406\u3057\u3065\u3089\u304f\u306a\u308b\u306e\u3067\u3001\u30de\u30af\u30ed\u304b\u3089\u5217\u5e45\u3092\u30b3\u30f3\u30c8\u30ed\u30fc\u30eb\u3067\u304d\u308b\u3088\u3046\u306b\u3059\u308b\u3053\u3068\u3002<br \/>\n\u4e00\u89a7\u8868\u306e\u5f62\u5f0f\u304b\u3089\u30c1\u30e3\u30fc\u30c8\u5f62\u5f0f\u3092\u4f5c\u6210\u3067\u304d\u308b\u3088\u3046\u3057\u305f\u3002<\/p>\n<p>UserForm1<\/p>\n<pre class=\"lang:vb decode:true \">Private Sub CommandButton1_Click()\r\n\r\nApplication.DisplayAlerts = False\r\n\r\nIf UserForm1.ComboBox1.Value = \"\" Or UserForm1.ComboBox2.Value = \"\" Then Exit Sub\r\n\r\nIf UserForm1.ComboBox5.Value = \"\" Or UserForm1.ComboBox5.Value = \"\u5168\u3066\u51fa\u529b\" Then\r\n  suppKey = \"\u5168\u3066\u51fa\u529b\"\r\nElse\r\n  suppKey = UserForm1.ComboBox5.Text\r\nEnd If\r\n\r\nf = UserForm1.ComboBox1.Value &amp; \"\/\" &amp; UserForm1.ComboBox2.Value &amp; \"\/1\"\r\nt = UserForm1.ComboBox3.Value &amp; \"\/\" &amp; UserForm1.ComboBox4.Value &amp; \"\/1\"\r\n\r\nIf IsDate(f) = False Or IsDate(t) = False Then Exit Sub\r\nIf CDate(f) &gt; CDate(t) Then Exit Sub\r\n\r\nFor Each w In Sheets\r\n  If w.Name = \"\u5de5\u7a0b\" Then yn = MsgBox(\"\u5de5\u7a0b\u30b7\u30fc\u30c8\u304c\u5b58\u5728\u3057\u307e\u3059\u3002\u524a\u9664\u3057\u3066\u7d9a\u884c\u3057\u307e\u3059\u304b\uff1f\", vbYesNo)\r\n  If yn = vbNo Then Exit Sub\r\nNext w\r\n\r\nIf yn = vbYes Then Sheets(\"\u5de5\u7a0b\").Delete\r\n\r\nSet w = Sheets.Add\r\nw.Name = \"\u5de5\u7a0b\"\r\n\r\nApplication.DisplayAlerts = True\r\n\r\nCall CreateProcessChart(UserForm1.ComboBox1.Value, UserForm1.ComboBox2.Value, UserForm1.ComboBox3.Value, UserForm1.ComboBox4.Value, suppKey)\r\nUnload UserForm1\r\n\r\nEnd Sub\r\n\r\nPrivate Sub UserForm_Initialize()\r\n\r\nUserForm1.ComboBox1.AddItem Year(Now)\r\nUserForm1.ComboBox1.AddItem Year(DateAdd(\"yyyy\", 1, Now))\r\nUserForm1.ComboBox1.AddItem Year(DateAdd(\"yyyy\", 2, Now))\r\n\r\nUserForm1.ComboBox3.AddItem Year(Now)\r\nUserForm1.ComboBox3.AddItem Year(DateAdd(\"yyyy\", 1, Now))\r\nUserForm1.ComboBox3.AddItem Year(DateAdd(\"yyyy\", 2, Now))\r\n\r\nFor m = 1 To 12\r\n\r\n  UserForm1.ComboBox2.AddItem m\r\n  UserForm1.ComboBox4.AddItem m\r\n  \r\nNext m\r\n\r\nUserForm1.ComboBox1.Text = Year(Now)\r\nUserForm1.ComboBox2.Text = Month(Now)\r\nUserForm1.ComboBox3.Text = Year(Now)\r\nUserForm1.ComboBox4.Text = Month(Now)\r\n\r\n'UserForm1.ComboBox3.Text = Year(DateAdd(\"m\", 3, Now))\r\n'UserForm1.ComboBox4.Text = Month(DateAdd(\"m\", 3, Now))\r\n\r\nDim dic: Set dic = CreateObject(\"Scripting.Dictionary\")\r\n\r\nFor r = 6 To Sheets(\"\u5165\u529b\").UsedRange.Rows.Count\r\n  If Not dic.Exists(Sheets(\"\u5165\u529b\").Cells(r, 4).Value) Then dic.Add Sheets(\"\u5165\u529b\").Cells(r, 4).Value, \"\"\r\nNext r\r\n\r\nIf Not dic.Exists(\"\u5168\u3066\u51fa\u529b\") Then dic.Add \"\u5168\u3066\u51fa\u529b\", \"\"\r\n\r\nKeys = dic.Keys\r\nFor i = 0 To dic.Count - 1\r\n  UserForm1.ComboBox5.AddItem Keys(i)\r\nNext i\r\n\r\nSet dic = Nothing\r\n\r\nUserForm1.ComboBox5.Text = \"\u5168\u3066\u51fa\u529b\"\r\n\r\nEnd Sub\r\n\r\n<\/pre>\n<p>Module2<\/p>\n<pre class=\"lang:vb decode:true \">Sub RestContext()\r\n\r\nOn Error Resume Next\r\n\r\nApplication.CommandBars(\"cell\").Controls(\"\u5217\u5e45\").Delete\r\nApplication.CommandBars(\"cell\").Controls(\"\u5217\u5e45\").Delete\r\nApplication.CommandBars(\"cell\").Controls(\"\u5de5\u7a0b\u30d5\u30a9\u30fc\u30e0\u8868\u793a\").Delete\r\nApplication.CommandBars(\"cell\").Controls(\"\u5de5\u7a0b\u30d5\u30a9\u30fc\u30e0\u8868\u793a\").Delete\r\n\r\nEnd Sub\r\n\r\nSub SetContext()\r\n\r\nWith Application.CommandBars(\"cell\").Controls.Add(Type:=msoControlPopup)\r\n\r\n.Caption = \"\u5217\u5e45\"\r\n\r\n  With .Controls.Add(Type:=msoControlButton) ' (Type:=msoControlButton)\u306f\u306a\u304f\u3066\u3082OK\r\n  .Caption = \"\u5217\u5e45\u53d6\u5f97\"\r\n  .OnAction = \"getColsWidth\"\r\n  End With\r\n  \r\n  With .Controls.Add\r\n  .Caption = \"\u5217\u5e45\u6307\u5b9a(1)\"\r\n  .OnAction = \"'setCols(2)'\" '\u5f15\u6570\u3092\u6e21\u3059\u306a\u3089 ' \u304c\u5fc5\u8981\u3002\u3042\u308b\u3044\u306f\u3001ActionControl.Caption\u306b\u3066\r\n  End With\r\n\r\n  With .Controls.Add\r\n  .Caption = \"\u5217\u5e45\u6307\u5b9a(2)\"\r\n  .OnAction = \"'setCols(3)'\"\r\n  End With\r\n\r\n  With .Controls.Add\r\n  .Caption = \"\u5217\u5e45\u6307\u5b9a(3)\"\r\n  .OnAction = \"'setCols(4)'\"\r\n  End With\r\n\r\nEnd With\r\n\r\nWith Application.CommandBars(\"cell\").Controls.Add\r\n  .Caption = \"\u5de5\u7a0b\u30d5\u30a9\u30fc\u30e0\u8868\u793a\"\r\n  .OnAction = \"UserFormShow\"\r\nEnd With\r\n\r\nEnd Sub\r\n\r\nSub setCols(k As Integer)\r\n\r\nFor i = 3 To 51\r\n  If Sheets(\"\u8a2d\u5b9a\").Cells(i, k).Value = \"\" Then\r\n    MsgBox \"\u8a2d\u5b9a\u306b\u4e0d\u6b63\u304c\u3042\u308a\u307e\u3059\u3002\"\r\n    Exit Sub\r\n  End If\r\nNext\r\n\r\nSheets(\"\u5165\u529b\").Activate\r\n\r\nFor i = 3 To 51\r\n\r\n  Sheets(\"\u5165\u529b\").Columns(i - 2).ColumnWidth = Sheets(\"\u8a2d\u5b9a\").Cells(i, k).Value\r\n\r\nNext\r\n\r\nEnd Sub\r\n\r\nSub getColsWidth()\r\n\r\nSheets(\"\u8a2d\u5b9a\").Activate\r\nSheets(\"\u8a2d\u5b9a\").Range(\"E3:E51\").Value = \"\"\r\n\r\nFor i = 3 To 51\r\n\r\n  Sheets(\"\u8a2d\u5b9a\").Cells(i, 5).Value = Sheets(\"\u5165\u529b\").Columns(i - 2).ColumnWidth\r\n\r\nNext\r\n\r\nEnd Sub\r\n<\/pre>\n<p>Module3<\/p>\n<pre class=\"lang:vb decode:true \">Sub UserFormShow()\r\n\r\nUserForm1.Show\r\n    \r\nEnd Sub\r\n\r\nSub CreateProcessChart(y, m, yy, mm, suppKey)\r\n\r\nSheets(\"\u5de5\u7a0b\").Cells(1, 1).Value = \"\u88fd\u4f5c\u5148\"\r\nSheets(\"\u5de5\u7a0b\").Cells(1, 2).Value = \"\u5de5\u756a\"\r\nSheets(\"\u5de5\u7a0b\").Cells(1, 3).Value = \"\u578b\u5f0f\"\r\nSheets(\"\u5de5\u7a0b\").Cells(1, 4).Value = \"\u6570\u91cf\"\r\nSheets(\"\u5de5\u7a0b\").Cells(1, 5).Value = \"\u5ba2\u5148\"\r\n\r\nymd = DateAdd(\"m\", -1, CDate(y &amp; \"\/\" &amp; m &amp; \"\/21\"))\r\nymdymd = CDate(yy &amp; \"\/\" &amp; mm &amp; \"\/20\")\r\nc = 6\r\n\r\nDo While CDate(ymd) &lt;= CDate(ymdymd)\r\n\r\n  Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value = ymd\r\n  \r\n  ymd = DateAdd(\"d\", 1, ymd)\r\n  c = c + 1\r\n\r\nLoop\r\n\r\ni = 2\r\n\r\nFor r = 6 To Sheets(\"\u5165\u529b\").UsedRange.Rows.Count\r\n\r\n  flg = True\r\n  If suppKey &lt;&gt; \"\u5168\u3066\u51fa\u529b\" And suppKey &lt;&gt; Sheets(\"\u5165\u529b\").Range(\"D\" &amp; r).Value Then flg = False\r\n\r\n  If Sheets(\"\u5165\u529b\").Range(\"AK\" &amp; r).Value = \"\u6709\" And flg = True Then\r\n  \r\n    Sheets(\"\u5de5\u7a0b\").Range(\"A\" &amp; i).Value = Sheets(\"\u5165\u529b\").Range(\"D\" &amp; r).Value\r\n    Sheets(\"\u5de5\u7a0b\").Range(\"B\" &amp; i).Value = Sheets(\"\u5165\u529b\").Range(\"H\" &amp; r).Value\r\n    Sheets(\"\u5de5\u7a0b\").Range(\"C\" &amp; i).Value = Sheets(\"\u5165\u529b\").Range(\"J\" &amp; r).Value\r\n    Sheets(\"\u5de5\u7a0b\").Range(\"D\" &amp; i).Value = Sheets(\"\u5165\u529b\").Range(\"M\" &amp; r).Value\r\n    Sheets(\"\u5de5\u7a0b\").Range(\"E\" &amp; i).Value = Sheets(\"\u5165\u529b\").Range(\"N\" &amp; r).Value\r\n    \r\n    rangeAddress = Split(\"E,F,R,T,U\", \",\")\r\n    chartText = Split(\"\u5b8c\u6210\u671f\u65e5,\u672c\u7d0d\u671f,\u51fa\u56f3\u65e5,\u88fd\u7f36\u691c\u67fb,\u5b8c\u6210\u691c\u67fb\", \",\")\r\n    ChartColor = Split(\"&amp;HCC99FF,&amp;HCC99FF,&amp;H99CCFF,&amp;H99CCFF,&amp;H99CCFF\", \",\")\r\n    For a = 0 To 4\r\n      If IsDate(Sheets(\"\u5165\u529b\").Range(rangeAddress(a) &amp; r).Value) = True Then\r\n        c = 6\r\n        Do While Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value &lt;&gt; \"\"\r\n          If CDate(Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value) = CDate(Sheets(\"\u5165\u529b\").Range(rangeAddress(a) &amp; r).Value) Then\r\n            Sheets(\"\u5de5\u7a0b\").Cells(i, c).Value = chartText(a)\r\n            Sheets(\"\u5de5\u7a0b\").Cells(i, c).Interior.Color = ChartColor(a)\r\n          End If\r\n          c = c + 1\r\n        Loop\r\n      End If\r\n    Next a\r\n  \r\n    fromRangeAddress = Split(\"AM,AP,AS,AV\", \",\")\r\n    toRangeAddress = Split(\"AN,AQ,AT,AW\", \",\")\r\n    chartTextAddress = Split(\"AL,AO,AR,AU\", \",\")\r\n    ChartColor = Split(\"&amp;H663399,&amp;HFF6633,&amp;H00CC99,&amp;H00CCFF\", \",\")\r\n    For a = 0 To 3\r\n      fromDate = Sheets(\"\u5165\u529b\").Range(fromRangeAddress(a) &amp; r).Value\r\n      toDate = Sheets(\"\u5165\u529b\").Range(toRangeAddress(a) &amp; r).Value\r\n      chartText = Sheets(\"\u5165\u529b\").Range(chartTextAddress(a) &amp; r).Value\r\n      textFlag = False\r\n      If IsDate(fromDate) = True Then\r\n        If IsDate(toDate) = False Then toDate = fromDate\r\n        c = 6\r\n        Do While Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value &lt;&gt; \"\"\r\n          If CDate(Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value) &gt;= CDate(fromDate) And _\r\n             CDate(Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value) &lt;= CDate(toDate) Then\r\n            If textFlag = False Then\r\n              Sheets(\"\u5de5\u7a0b\").Cells(i, c).Value = Sheets(\"\u5de5\u7a0b\").Cells(i, c).Value &amp; \" \" &amp; chartText\r\n              textFlag = True\r\n            End If\r\n            Sheets(\"\u5de5\u7a0b\").Cells(i, c).Interior.Color = ChartColor(a)\r\n          End If\r\n          c = c + 1\r\n        Loop\r\n      End If\r\n    Next a\r\n    \r\n    i = i + 1\r\n  \r\n  End If\r\n\r\nNext r\r\n\r\nSheets(\"\u5de5\u7a0b\").Rows(1).NumberFormatLocal = \"dd\"\r\nSheets(\"\u5de5\u7a0b\").Rows(1).ShrinkToFit = True\r\nSheets(\"\u5de5\u7a0b\").Rows(1).HorizontalAlignment = xlCenter\r\nSheets(\"\u5de5\u7a0b\").Columns.AutoFit\r\n\r\nc = 6\r\nDo While Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value &lt;&gt; \"\"\r\n  Sheets(\"\u5de5\u7a0b\").Columns(c).ColumnWidth = 3.4\r\n  If c = 6 Or Day(Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value) = 1 Then\r\n    Sheets(\"\u5de5\u7a0b\").Cells(1, c).NumberFormatLocal = \"mm\/dd\"\r\n  End If\r\n  If Weekday(Sheets(\"\u5de5\u7a0b\").Cells(1, c).Value) = 1 Then Sheets(\"\u5de5\u7a0b\").Cells(1, c).Font.Color = RGB(255, 0, 0)\r\n  c = c + 1\r\nLoop\r\n\r\nSheets(\"\u5de5\u7a0b\").UsedRange.Borders.LineStyle = True\r\nSheets(\"\u5de5\u7a0b\").Cells(2, 1).Select\r\nActiveWindow.FreezePanes = True\r\n\r\nEnd Sub\r\n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>\u5217\u6570\u304c\u591a\u304f\u306a\u308b\u3068\u7ba1\u7406\u3057\u3065\u3089\u304f\u306a\u308b\u306e\u3067\u3001\u30de\u30af\u30ed\u304b\u3089\u5217\u5e45\u3092\u30b3\u30f3\u30c8\u30ed\u30fc\u30eb\u3067\u304d\u308b\u3088\u3046\u306b\u3059\u308b\u3053\u3068\u3002 \u4e00\u89a7\u8868\u306e\u5f62\u5f0f\u304b\u3089\u30c1\u30e3\u30fc\u30c8\u5f62\u5f0f\u3092\u4f5c\u6210\u3067\u304d\u308b\u3088\u3046\u3057\u305f\u3002 UserForm1 Private Sub CommandButton1_Cl &hellip; <\/p>\n<p class=\"link-more\"><a href=\"https:\/\/appbay.org\/?p=1688\" class=\"more-link\"><span class=\"screen-reader-text\">&#8220;VBA \u5916\u6ce8\u7ba1\u7406\u7528\u5de5\u7a0b\u30c1\u30e3\u30fc\u30c8\u4f5c\u6210\u6a5f\u80fd&#8221; \u306e<\/span>\u7d9a\u304d\u3092\u8aad\u3080<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"closed","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[1],"tags":[5],"class_list":["post-1688","post","type-post","status-publish","format-standard","hentry","category-1","tag-vba"],"_links":{"self":[{"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts\/1688","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=1688"}],"version-history":[{"count":1,"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts\/1688\/revisions"}],"predecessor-version":[{"id":1689,"href":"https:\/\/appbay.org\/index.php?rest_route=\/wp\/v2\/posts\/1688\/revisions\/1689"}],"wp:attachment":[{"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=1688"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=1688"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/appbay.org\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=1688"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}