{"id":623,"date":"2012-07-03T16:05:24","date_gmt":"2012-07-03T07:05:24","guid":{"rendered":"http:\/\/fujiitoshiki.com\/improvesociety\/?p=623"},"modified":"2014-11-07T16:50:59","modified_gmt":"2014-11-07T07:50:59","slug":"post-623","status":"publish","type":"post","link":"https:\/\/www.fujiitoshiki.com\/improvesociety\/?p=623","title":{"rendered":"\u6539\u8a02\u7248\u300e\u8eab\u4f53\u6d3b\u52d5\u306e\u30e1\u30c3\u30c4\u8868\u300f\u304b\u3089\u30c6\u30ad\u30b9\u30c8\u3092\u62bd\u51fa\u3059\u308b"},"content":{"rendered":"


\n\"\"<\/a>
\n\"\"<\/p>\n

\u3000\u56fd\u7acb\u5065\u5eb7\u30fb\u6804\u990a\u7814\u7a76\u6240\u304c2011\u5e74\u7248\u300e\u8eab\u4f53\u6d3b\u52d5\u306e\u30e1\u30c3\u30c4\u8868\u300f\u3092\u6539\u8a02\u3057\u307e\u3057\u305f\uff0e\u4e0b\u8a18\u30ea\u30f3\u30af\u306fPDF\u30d5\u30a1\u30a4\u30eb\u3067\u3059\u304c\uff0c\u305d\u306e\u307e\u307e\u3067\u306f\u4f7f\u3044\u306b\u304f\u3044\u305f\u3081EXCEL\u3067\u30c6\u30ad\u30b9\u30c8\u60c5\u5831\u3092\u62bd\u51fa\u3057\u307e\u3057\u305f\uff0e2012\u5e747\u67083\u65e5\uff0c\u56fd\u7acb\u5065\u5eb7\u30fb\u6804\u990a\u7814\u7a76\u6240\u306b\u62bd\u51fa\u3057\u305f\u30c6\u30ad\u30b9\u30c8\u30d5\u30a1\u30a4\u30eb\u3092\u516c\u958b\u3057\u3066\u826f\u3044\u304b\u554f\u3044\u5408\u308f\u305b\u307e\u3057\u305f\uff0e<\/p>\n

\u8eab\u4f53\u6d3b\u52d5\u306e\u30e1\u30c3\u30c4\u8868<\/a><\/p>\n


\n\"\"<\/a>
\n\"\"<\/p>\n

1. PDF\u30d5\u30a1\u30a4\u30eb\u3092\u958b\u304d\uff0c\u5168\u3066\u3092\u9078\u629e\u3057\u3066\u30b3\u30d4\u30fc\u3057\u307e\u3059\uff0e<\/p>\n

2. EXCEL\u306e\u65b0\u898f\u30d6\u30c3\u30af\u3092\u4f5c\u6210\u3057\uff0c\u30c6\u30ad\u30b9\u30c8\u30d5\u30a1\u30a4\u30eb\u30a6\u30a3\u30b6\u30fc\u30c9\u3092\u4f7f\u7528\u3057\u3066\u8cbc\u308a\u4ed8\u3051\u307e\u3059\uff0e\u3053\u306e\u969b\uff0c\u30c6\u30ad\u30b9\u30c8\u30d5\u30a1\u30a4\u30eb\u30a6\u30a3\u30b6\u30fc\u30c9\u306e2\u756a\u76ee\u306e\u30bf\u30d6\u3067\u533a\u5207\u308a\u6587\u5b57\u306e\u5168\u3066\u306e\u30c1\u30a7\u30c3\u30af\u3092\u5916\u3057\u3066\u4e0b\u3055\u3044\uff0e3\u756a\u76ee\u306e\u30bf\u30d6\u3067\u306f\u5217\u306e\u30c7\u30fc\u30bf\u5f62\u5f0f\u3092\u300e\u6587\u5b57\u5217\u300f\u306b\u5909\u66f4\u3057\u3066\u4e0b\u3055\u3044\uff0e<\/p>\n

3. ‘Alt’ \u30ad\u30fc\u3068 ‘F11’ \u30ad\u30fc\u3092\u62bc\u4e0b\u3057\u3066 VBE \u3092\u8d77\u52d5\u3057\uff0c\u6a19\u6e96\u30e2\u30b8\u30e5\u30fc\u30eb\u3092\u633f\u5165\u3057\u3066\u4e0b\u8a18\u30b3\u30fc\u30c9\u3092\u5b9f\u884c\u3057\u3066\u4e0b\u3055\u3044\uff0e<\/p>\n

Option Explicit\r\nSub METS()\r\nDim mySht   As Worksheet\r\nDim myRng   As Range\r\nDim myAr    As Variant\r\nDim i       As Long\r\nDim j       As Long\r\nDim myReg   As Object\r\nDim myMatches   As Object\r\nDim myMatch     As Object\r\nConst strReg    As String = \"^[0-9]{5}$\"\r\nDim CODE()  As String\r\nDim METS()  As Single\r\nDim MajorHeading()  As String\r\nDim SpecificActivities()    As String\r\nDim myArray()   As Variant\r\nSet myReg = CreateObject(\"VBScript.RegExp\")\r\nWith myReg\r\n    .Pattern = strReg\r\n    .IgnoreCase = True\r\n    .Global = True\r\nEnd With\r\n\r\nSet mySht = ActiveSheet\r\nSet myRng = mySht.UsedRange\r\nmyAr = myRng\r\nj = 0\r\nFor i = LBound(myAr) To UBound(myAr)\r\n    If myReg.Test(myAr(i, 1)) Then\r\n        Set myMatches = myReg.Execute(myAr(i, 1))\r\n        ReDim Preserve CODE(j)\r\n        ReDim Preserve METS(j)\r\n        ReDim Preserve MajorHeading(j)\r\n        ReDim Preserve SpecificActivities(j)\r\n        CODE(j) = myAr(i, 1)\r\n        METS(j) = myAr(i + 1, 1)\r\n        MajorHeading(j) = myAr(i + 2, 1)\r\n        SpecificActivities(j) = myAr(i + 3, 1)\r\n        j = j + 1\r\n    End If\r\nNext i\r\nReDim myArray(j, 3)\r\nFor j = LBound(myArray) To UBound(myArray) - 1\r\n    myArray(j, 0) = CODE(j)\r\n    myArray(j, 1) = METS(j)\r\n    myArray(j, 2) = MajorHeading(j)\r\n    myArray(j, 3) = SpecificActivities(j)\r\nNext j\r\nSet mySht = Worksheets.Add\r\nmySht.Range(\"A1\").Value = \"CODE\"\r\nmySht.Range(\"B1\").Value = \"METS\"\r\nmySht.Range(\"C1\").Value = \"MajorHeading\"\r\nmySht.Range(\"D1\").Value = \"SpecificActivities\"\r\nmySht.Range(\"A2:D827\") = myArray\r\nEnd Sub\r\n<\/pre>\n