{"id":456,"date":"2012-05-25T18:33:36","date_gmt":"2012-05-25T09:33:36","guid":{"rendered":"http:\/\/fujiitoshiki.com\/improvesociety\/?p=456"},"modified":"2017-04-27T10:50:16","modified_gmt":"2017-04-27T01:50:16","slug":"post-456","status":"publish","type":"post","link":"https:\/\/www.fujiitoshiki.com\/improvesociety\/?p=456","title":{"rendered":"Classify the Item_Number of the \u2018Standard Tables of Food Composition in Japan 2010\u2032, Part 2"},"content":{"rendered":"<div class=\"theContentWrap-ccc\"><p>According to the <a href=\"\/\/fujiitoshiki.com\/improvesociety\/?p=51\" target=\"_blank\">article<\/a>, download the PDF files &#8216;1299012_1.pdf&#8217; to &#8216;1299012_18.pdf&#8217;.  Corresponding to each PDF file in PDF files, copy all text from one file and option paste to one worksheet.  As a result, you would make 18 worksheets in a book.  In the first tab of &#8216;Text File Wizard&#8217;, select option \u2018The data field separated by delimiters such as comma or tab&#8217;.  Go to the last tab without any change in second tab. In the last tab, change option data type of the first column to \u2018String\u2019.  Mainly in column A of all worksheets, you have to fix cell value by yourself.  Save the book as &#8216;Category.xlsm&#8217;.  Furthermore, download the EXCEL book from <a href=\"\/\/www.geocities.jp\/eisan001588\/labo\/l_index.html\" target=\"_blank\">this site<\/a>, copy worksheet from it to &#8216;Category.xlsm&#8217; which you previously prepared, and change the sheet name to &#8216;Sheet0&#8217;.<\/p>\n<p>Copy or move the worksheet, which you made at <a href=\"\/\/fujiitoshiki.com\/improvesociety\/?p=439\" target=\"_blank\">Classify the Item_Number of the \u2018Standard Tables of Food Composition in Japan 2010\u2032, Part 1<\/a>, to &#8216;Category.xlsm&#8217;.  As a result, &#8216;Category.xlsm&#8217; book has 20 worksheets.  Press &#8216;Alt&#8217; key and &#8216;F11&#8217; key to launch VBE, insert module and run the code below.  The code makes &#8216;M_CATEGORY&#8217; sheet.  <\/p>\n<pre class=\"lang:vb decode:true \" >\r\nOption Explicit\r\nSub Select_Class()\r\nDim tmpSht              As Worksheet\r\nDim tmpRng              As Range\r\nDim tmpArray            As Variant\r\nDim workArray           As Variant\r\nDim h                   As Long\r\nDim i                   As Long\r\nDim j                   As Long\r\nDim k                   As Long\r\nDim l                   As Long\r\nDim m                   As Long\r\nDim n                   As Long\r\nDim p                   As Long\r\nDim q                   As Long\r\nDim r                   As Long\r\nDim RegExp_Japanese     As Object\r\nDim RegExp_English      As Object\r\nDim RegExp_ItemNum      As Object\r\nConst PtnJPN            As String = \"[^A-Za-z0-9'\\.\\-\\*]{2,}\"\r\nConst PtnENG            As String = \"^[A-Za-z0-9'\\,\\.\\-\\%]+$\"\r\nConst PtnItemNum        As String = \"^[0-9]{5}$\"\r\nDim Item_Number()       As String\r\nDim JapaneseItem()      As String\r\nDim EnglishItem()       As String\r\nDim EnglishString       As String\r\nDim JapaneseClass()     As String\r\nDim English_Class()     As String\r\nDim ClassStringEN       As String\r\nDim ItemNumArray()      As String\r\nDim ItemENGArray()      As String\r\nDim ClassArrayJP()      As String\r\nDim ClassArrayEN()      As String\r\nDim RegExp_AngleBracket As Object\r\nDim RegExp_RoundStartJP As Object\r\nDim RegExp_RoundStartEN As Object\r\nDim RegExp_RoundExitEN  As Object\r\nConst Ptn_Round_Start   As String = \"^(\\(|\uff08)\"\r\nConst Ptn_Round_Exit    As String = \"(\\)|\uff09)$\"\r\nDim StringRoundEnglish  As String\r\nDim SubClassJapanese()  As String\r\nDim SubClass_English()  As String\r\nDim RegExp_Square_Start As Object\r\nDim RegExp_SquareExitEN As Object\r\nConst Ptn_Angle_Start   As String = \"^[<\uff1c]\"\r\nConst Ptn_SquareStart   As String = \"^\\[\"\r\nConst Ptn_Square_Exit   As String = \"\\]$\"\r\nDim MidleClassJP()      As String\r\nDim MidleClassEN()      As String\r\nDim StrMidClassENG      As String\r\nDim SubClass_JPN()      As String\r\nDim SubClass_ENG()      As String\r\nDim mySht               As Worksheet\r\nDim myRng               As Range\r\nDim myAr                As Variant\r\nDim workArray2()        As String\r\nDim workArray3()        As String\r\nDim mySht2              As Worksheet\r\nDim myRng2              As Range\r\nDim myAr2               As Variant\r\nDim CEREALS             As Long\r\nDim POTATOES            As Long\r\nDim SUGARS              As Long\r\nDim PULSES              As Long\r\nDim NUTS                As Long\r\nDim VEGETABLES          As Long\r\nDim FRUITS              As Long\r\nDim MUSHROOMS           As Long\r\nDim ALGAE               As Long\r\nDim FISHES              As Long\r\nDim MEATS               As Long\r\nDim EGGS                As Long\r\nDim MILK                As Long\r\nDim OIL                 As Long\r\nDim CONFECTIONERIES     As Long\r\nDim BEVERAGES           As Long\r\nDim SEASONINGS          As Long\r\nDim PREPARED            As Long\r\n    Set RegExp_Japanese = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_Japanese\r\n        .Pattern = PtnJPN\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\n    Set RegExp_English = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_English\r\n        .Pattern = PtnENG\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\n    Set RegExp_ItemNum = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_ItemNum\r\n        .Pattern = PtnItemNum\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\n    Set RegExp_Square_Start = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_Square_Start\r\n        .Pattern = Ptn_SquareStart\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\n    Set RegExp_SquareExitEN = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_SquareExitEN\r\n        .Pattern = \"[A-Za-z0-9'\\,\\.\\-\\%]+\" &#038; Ptn_Square_Exit\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\n    Set RegExp_RoundStartJP = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_RoundStartJP\r\n        .Pattern = Ptn_Round_Start &#038; \"[^A-Za-z0-9'\\.\\-\\*]{2,}\"\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\n    Set RegExp_RoundStartEN = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_RoundStartEN\r\n        .Pattern = Ptn_Round_Start &#038; \"[A-Za-z'\\,\\.\\-\\%]+\"\r\n    End With\r\n    Set RegExp_RoundExitEN = CreateObject(\"VBScript.RegExp\")\r\n    With RegExp_RoundExitEN\r\n        .Pattern = \"[A-Za-z0-9'\\,\\.\\-\\%]+\" &#038; Ptn_Round_Exit\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\nj = 0\r\nk = 0\r\nl = 0\r\nm = 0\r\nq = 0\r\nFor Each tmpSht In Worksheets\r\n    If tmpSht.Name = \"M_CATEGORY\" Then\r\n        MsgBox prompt:=\"This book already has M_CATEGORY sheet.\" &#038; vbCrLf &#038; _\r\n                       \"Exit procedure.\", _\r\n              Buttons:=vbOKOnly, _\r\n                Title:=\"Internal Error\"\r\n        Exit Sub\r\n    End If\r\n    If tmpSht.Name <> \"Sheet0\" And _\r\n       tmpSht.Name <> \"Sheet00\" And _\r\n       tmpSht.Name <> \"Result\" Then\r\n        Set tmpRng = tmpSht.UsedRange\r\n        tmpArray = tmpRng\r\n        workArray = NoCancelArray(tmpArray)\r\n        For h = LBound(workArray) To UBound(workArray)\r\n            For i = workArray(h, 0) To workArray(h, 1)\r\n                On Error Resume Next\r\n                If RegExp_ItemNum.Test(tmpArray(i, 1)) And _\r\n                   tmpArray(i, 2) <> \"\uff08\u6b20\u756a\uff09\" Then\r\n                    EnglishString = \"\"\r\n                    ReDim Preserve Item_Number(j)\r\n                    ReDim Preserve JapaneseItem(j)\r\n                    ReDim Preserve EnglishItem(j)\r\n                    For p = 1 To 6\r\n                        If RegExp_English.Test(tmpArray(i + 1, p)) Then\r\n                            EnglishString = EnglishString & \" \" & tmpArray(i + 1, p)\r\n                            EnglishString = Trim(EnglishString)\r\n                        Else\r\n                            Exit For\r\n                        End If\r\n                    Next p\r\n                    Item_Number(j) = tmpArray(i, 1)\r\n                    JapaneseItem(j) = tmpArray(i, 2)\r\n                    EnglishItem(j) = EnglishString\r\n                    j = j + 1\r\n                End If\r\n                On Error GoTo 0\r\n                If RegExp_Japanese.Test(tmpArray(i, 1)) And _\r\n                   RegExp_English.Test(tmpArray(i + 1, 1)) Then\r\n                    ClassStringEN = \"\"\r\n                    ReDim Preserve JapaneseClass(k)\r\n                    ReDim Preserve English_Class(k)\r\n                    For p = 1 To 6\r\n                        If RegExp_English.Test(tmpArray(i + 1, p)) Then\r\n                            ClassStringEN = ClassStringEN & \" \" & tmpArray(i + 1, p)\r\n                            ClassStringEN = Trim(ClassStringEN)\r\n                        Else\r\n                            Exit For\r\n                        End If\r\n                    Next p\r\n                    JapaneseClass(k) = tmpArray(i, 1)\r\n                    English_Class(k) = ClassStringEN\r\n                    k = k + 1\r\n                End If\r\n                If RegExp_Square_Start.Test(tmpArray(i, 1)) And _\r\n                   RegExp_Square_Start.Test(tmpArray(i + 1, 1)) Then\r\n                    StrMidClassENG = \"\"\r\n                    ReDim Preserve MidleClassJP(l)\r\n                    ReDim Preserve MidleClassEN(l)\r\n                    For p = 1 To 6\r\n                        StrMidClassENG = StrMidClassENG + \" \" + tmpArray(i + 1, p)\r\n                        StrMidClassENG = Trim(StrMidClassENG)\r\n                        If RegExp_SquareExitEN.Test(tmpArray(i + 1, p)) Then Exit For\r\n                    Next p\r\n                    MidleClassJP(l) = tmpArray(i, 1)\r\n                    MidleClassEN(l) = StrMidClassENG\r\n                    l = l + 1\r\n                End If\r\n                If RegExp_RoundStartJP.Test(tmpArray(i, 1)) And _\r\n                   RegExp_RoundStartEN.Test(tmpArray(i + 1, 1)) Then\r\n                    StringRoundEnglish = \"\"\r\n                    ReDim Preserve SubClassJapanese(m)\r\n                    ReDim Preserve SubClass_English(m)\r\n                    For p = 1 To 6\r\n                        StringRoundEnglish = StringRoundEnglish & \" \" & tmpArray(i + 1, p)\r\n                        StringRoundEnglish = Trim(StringRoundEnglish)\r\n                        If RegExp_RoundExitEN.Test(tmpArray(i + 1, p)) Then Exit For\r\n                    Next p\r\n                    tmpArray(i, 1) = Replace(tmpArray(i, 1), \"(\", \"\uff08\")\r\n                    tmpArray(i, 1) = Replace(tmpArray(i, 1), \")\", \"\uff09\")\r\n                    SubClassJapanese(m) = tmpArray(i, 1)\r\n                    StringRoundEnglish = Replace(StringRoundEnglish, \"\uff08\", \"(\")\r\n                    StringRoundEnglish = Replace(StringRoundEnglish, \"\uff09\", \")\")\r\n                    SubClass_English(m) = StringRoundEnglish\r\n                    m = m + 1\r\n                End If\r\n            Next i\r\n        Next h\r\n        q = q + 1\r\n    End If\r\nNext tmpSht\r\nSet mySht = Worksheets(\"Sheet0\")\r\nSet myRng = Intersect(mySht.Range(\"A:H\"), mySht.UsedRange)\r\nmyAr = myRng\r\nReDim workArray2(UBound(myAr) - 1, 16)\r\nFor i = LBound(workArray2) To UBound(workArray2)\r\n    workArray2(i, 0) = myAr(i + 1, 1)\r\n    workArray2(i, 1) = myAr(i + 1, 2)\r\n    workArray2(i, 2) = myAr(i + 1, 3)\r\n    myAr(i + 1, 4) = Replace(myAr(i + 1, 4), \"(\", \"\uff08\")\r\n    myAr(i + 1, 4) = Replace(myAr(i + 1, 4), \")\", \"\uff09\")\r\n    workArray2(i, 6) = myAr(i + 1, 4)\r\n    workArray2(i, 8) = myAr(i + 1, 5)\r\n    workArray2(i, 10) = myAr(i + 1, 6)\r\n    workArray2(i, 12) = myAr(i + 1, 7)\r\n    workArray2(i, 14) = myAr(i + 1, 8)\r\nNext i\r\nSet mySht2 = Worksheets(\"Result\")\r\nSet myRng2 = mySht2.UsedRange\r\nmyAr2 = myRng2\r\nFor i = LBound(workArray2) To UBound(workArray2)\r\n    For k = LBound(JapaneseClass) To UBound(JapaneseClass)\r\n        If workArray2(i, 2) = JapaneseClass(k) Then\r\n           workArray2(i, 3) = English_Class(k)\r\n        End If\r\n        If workArray2(i, 4) = JapaneseClass(k) Then\r\n           workArray2(i, 5) = English_Class(k)\r\n        End If\r\n        If workArray2(i, 8) = JapaneseClass(k) Then\r\n           workArray2(i, 9) = English_Class(k)\r\n        End If\r\n        If workArray2(i, 12) = JapaneseClass(k) Then\r\n           workArray2(i, 13) = English_Class(k)\r\n        End If\r\n    Next k\r\n    For m = LBound(SubClassJapanese) To UBound(SubClassJapanese)\r\n        If workArray2(i, 6) = SubClassJapanese(m) Then\r\n           workArray2(i, 7) = SubClass_English(m)\r\n        End If\r\n    Next m\r\n    For l = UBound(MidleClassJP) To LBound(MidleClassJP) Step -1\r\n        If workArray2(i, 10) = MidleClassJP(l) Then\r\n           workArray2(i, 11) = MidleClassEN(l)\r\n        End If\r\n    Next l\r\n    For r = LBound(myAr2) To UBound(myAr2)\r\n        If workArray2(i, 0) = myAr2(r, 1) Then\r\n            workArray2(i, 4) = myAr2(r, 5)\r\n            On Error Resume Next\r\n            Select Case True\r\n            Case workArray2(i, 0) >= \"10001\" And workArray2(i, 0) <= \"10278\"\r\n                 workArray2(i, 4) = \"\uff1c\u9b5a\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"10319\" And workArray2(i, 0) <= \"10341\"\r\n                 workArray2(i, 4) = \"\uff1c\u3048\u3073\u30fb\u304b\u306b\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"10342\" And workArray2(i, 0) <= \"10362\"\r\n                 workArray2(i, 4) = \"\uff1c\u3044\u304b\u30fb\u305f\u3053\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"10376\" And workArray2(i, 0) <= \"10388\"\r\n                 workArray2(i, 4) = \"\uff1c\u6c34\u7523\u7df4\u308a\u88fd\u54c1\uff1e\"\r\n            Case workArray2(i, 0) >= \"11205\" And workArray2(i, 0) <= \"11240\"\r\n                 workArray2(i, 4) = \"\uff1c\u9ce5\u8089\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"11245\" And workArray2(i, 0) <= \"11246\"\r\n                 workArray2(i, 4) = \"\uff1c\u7363\u8089\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"11247\" And workArray2(i, 0) <= \"11247\"\r\n                 workArray2(i, 4) = \"\uff1c\u9ce5\u8089\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"13001\" And workArray2(i, 0) <= \"13050\"\r\n                 workArray2(i, 4) = \"\uff1c\u725b\u4e73\u53ca\u3073\u4e73\u88fd\u54c1\uff1e\"\r\n            Case workArray2(i, 0) >= \"15001\" And workArray2(i, 0) <= \"15040\"\r\n                 workArray2(i, 4) = \"\uff1c\u548c\u751f\u83d3\u5b50\u30fb\u548c\u534a\u751f\u83d3\u5b50\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15041\" And workArray2(i, 0) <= \"15068\"\r\n                 workArray2(i, 4) = \"\uff1c\u548c\u5e72\u83d3\u5b50\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15069\" And workArray2(i, 0) <= \"15072\"\r\n                 workArray2(i, 4) = \"\uff1c\u83d3\u5b50\u30d1\u30f3\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15073\" And workArray2(i, 0) <= \"15085\"\r\n                 workArray2(i, 4) = \"\uff1c\u30b1\u30fc\u30ad\u30fb\u30da\u30b9\u30c8\u30ea\u30fc\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15086\" And workArray2(i, 0) <= \"15091\"\r\n                 workArray2(i, 4) = \"\uff1c\u30c7\u30b6\u30fc\u30c8\u83d3\u5b50\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15092\" And workArray2(i, 0) <= \"15100\"\r\n                 workArray2(i, 4) = \"\uff1c\u30d3\u30b9\u30b1\u30c3\u30c8\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15101\" And workArray2(i, 0) <= \"15104\"\r\n                 workArray2(i, 4) = \"\uff1c\u30b9\u30ca\u30c3\u30af\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15105\" And workArray2(i, 0) <= \"15113\"\r\n                 workArray2(i, 4) = \"\uff1c\u30ad\u30e3\u30f3\u30c7\u30fc\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15114\" And workArray2(i, 0) <= \"15116\"\r\n                 workArray2(i, 4) = \"\uff1c\u30c1\u30e7\u30b3\u30ec\u30fc\u30c8\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15117\" And workArray2(i, 0) <= \"15117\"\r\n                 workArray2(i, 4) = \"\uff1c\u679c\u5b9f\u83d3\u5b50\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"15118\" And workArray2(i, 0) <= \"15120\"\r\n                 workArray2(i, 4) = \"\uff1c\u30c1\u30e5\u30fc\u30a4\u30f3\u30ac\u30e0\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"16001\" And workArray2(i, 0) <= \"16032\"\r\n                 workArray2(i, 4) = \"\uff1c\u30a2\u30eb\u30b3\u30fc\u30eb\u98f2\u6599\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"16033\" And workArray2(i, 0) <= \"16044\"\r\n                 workArray2(i, 4) = \"\uff1c\u8336\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"16045\" And workArray2(i, 0) <= \"16049\"\r\n                 workArray2(i, 4) = \"\uff1c\u30b3\u30fc\u30d2\u30fc\u30fb\u30b3\u30b3\u30a2\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"16050\" And workArray2(i, 0) <= \"16055\"\r\n                 workArray2(i, 4) = \"\uff1c\u305d\u306e\u4ed6\uff1e\"\r\n            Case workArray2(i, 0) >= \"17001\" And workArray2(i, 0) <= \"17054\"\r\n                 workArray2(i, 4) = \"\uff1c\u8abf\u5473\u6599\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"17055\" And workArray2(i, 0) <= \"17081\"\r\n                 workArray2(i, 4) = \"\uff1c\u9999\u8f9b\u6599\u985e\uff1e\"\r\n            Case workArray2(i, 0) >= \"17082\" And workArray2(i, 0) <= \"17084\"\r\n                 workArray2(i, 4) = \"\uff1c\u305d\u306e\u4ed6\uff1e\"\r\n            End Select\r\n            On Error GoTo 0\r\n            workArray2(i, 5) = myAr2(r, 6)\r\n            On Error Resume Next\r\n            Select Case True\r\n            Case workArray2(i, 0) >= \"10001\" And workArray2(i, 0) <= \"10278\"\r\n                 workArray2(i, 5) = \"<FISHES>\"\r\n            Case workArray2(i, 0) >= \"10319\" And workArray2(i, 0) <= \"10341\"\r\n                 workArray2(i, 5) = \"<PRAWNS\uff0cSHRIMPS AND CRABS>\"\r\n            Case workArray2(i, 0) >= \"10342\" And workArray2(i, 0) <= \"10362\"\r\n                 workArray2(i, 5) = \"<CEPHALOPODS>\"\r\n            Case workArray2(i, 0) >= \"10376\" And workArray2(i, 0) <= \"10388\"\r\n                 workArray2(i, 5) = \"<FISH PASTE PRODUCTS>\"\r\n            Case workArray2(i, 0) >= \"11205\" And workArray2(i, 0) <= \"11240\"\r\n                 workArray2(i, 5) = \"<POULTRIES>\"\r\n            Case workArray2(i, 0) >= \"11245\" And workArray2(i, 0) <= \"11246\"\r\n                 workArray2(i, 5) = \"<ANIMAL MEATS>\"\r\n            Case workArray2(i, 0) >= \"11247\" And workArray2(i, 0) <= \"11247\"\r\n                 workArray2(i, 5) = \"<POULTRIES>\"\r\n            Case workArray2(i, 0) >= \"13001\" And workArray2(i, 0) <= \"13050\"\r\n                 workArray2(i, 5) = \"<MILK AND DAIRY PRODUCTS>\"\r\n            Case workArray2(i, 0) >= \"15001\" And workArray2(i, 0) <= \"15040\"\r\n                 workArray2(i, 5) = \"<TRADITIONAL FRESH AND SEMI-DRY CONFECTIONERIES>\"\r\n            Case workArray2(i, 0) >= \"15041\" And workArray2(i, 0) <= \"15068\"\r\n                 workArray2(i, 5) = \"<TRADITIONAL DRY CONFECTIONERIES>\"\r\n            Case workArray2(i, 0) >= \"15069\" And workArray2(i, 0) <= \"15072\"\r\n                 workArray2(i, 5) = \"<JAPANESE BUNS>\"\r\n            Case workArray2(i, 0) >= \"15073\" And workArray2(i, 0) <= \"15085\"\r\n                 workArray2(i, 5) = \"<CAKES, BUNS AND PASTRIES>\"\r\n            Case workArray2(i, 0) >= \"15086\" And workArray2(i, 0) <= \"15091\"\r\n                 workArray2(i, 5) = \"<DESSERTS>\"\r\n            Case workArray2(i, 0) >= \"15092\" And workArray2(i, 0) <= \"15100\"\r\n                 workArray2(i, 5) = \"<BISCUITS>\"\r\n            Case workArray2(i, 0) >= \"15101\" And workArray2(i, 0) <= \"15104\"\r\n                 workArray2(i, 5) = \"<SNACKS>\"\r\n            Case workArray2(i, 0) >= \"15105\" And workArray2(i, 0) <= \"15113\"\r\n                 workArray2(i, 5) = \"<CANDIES>\"\r\n            Case workArray2(i, 0) >= \"15114\" And workArray2(i, 0) <= \"15116\"\r\n                 workArray2(i, 5) = \"<CHOCOLATES>\"\r\n            Case workArray2(i, 0) >= \"15117\" And workArray2(i, 0) <= \"15117\"\r\n                 workArray2(i, 5) = \"\uff1cCANDIED FRUITS\uff1e\"\r\n            Case workArray2(i, 0) >= \"15118\" And workArray2(i, 0) <= \"15120\"\r\n                 workArray2(i, 5) = \"<CHEWING GUMS>\"\r\n            Case workArray2(i, 0) >= \"16001\" And workArray2(i, 0) <= \"16032\"\r\n                 workArray2(i, 5) = \"<ALCOHOLIC BEVERAGES>\"\r\n            Case workArray2(i, 0) >= \"16033\" And workArray2(i, 0) <= \"16044\"\r\n                 workArray2(i, 5) = \"<TEAS>\"\r\n            Case workArray2(i, 0) >= \"16045\" And workArray2(i, 0) <= \"16049\"\r\n                 workArray2(i, 5) = \"COFFEES AND COCOAS>\"\r\n            Case workArray2(i, 0) >= \"16050\" And workArray2(i, 0) <= \"16055\"\r\n                 workArray2(i, 5) = \"<OTHERS>\"\r\n            Case workArray2(i, 0) >= \"17001\" And workArray2(i, 0) <= \"17054\"\r\n                 workArray2(i, 5) = \"<SEASONINGS>\"\r\n            Case workArray2(i, 0) >= \"17055\" And workArray2(i, 0) <= \"17081\"\r\n                 workArray2(i, 5) = \"<SPICES>\"\r\n            Case workArray2(i, 0) >= \"17082\" And workArray2(i, 0) <= \"17084\"\r\n                 workArray2(i, 5) = \"<OTHERS>\"\r\n            End Select\r\n            On Error GoTo 0\r\n            If workArray2(i, 6) <> \"\" And _\r\n               workArray2(i, 7) = \"\" Then\r\n                workArray2(i, 7) = myAr2(r, 8)\r\n            End If\r\n            If workArray2(i, 8) <> \"\" And _\r\n               workArray2(i, 9) = \"\" Then\r\n                If myAr2(r, 10) = \"\" Then\r\n                    workArray2(i, 9) = myAr2(r, 15)\r\n                Else\r\n                    workArray2(i, 9) = myAr2(r, 10)\r\n                End If\r\n            End If\r\n            If workArray2(i, 12) <> \"\" And _\r\n               workArray2(i, 13) = \"\" Then\r\n                workArray2(i, 13) = myAr2(r, 15)\r\n            End If\r\n            If workArray2(i, 14) <> \"\" Then\r\n                workArray2(i, 15) = myAr2(r, 15)\r\n            End If\r\n            workArray2(i, 16) = myAr2(r, 11)\r\n        End If\r\n        Select Case True\r\n            Case workArray2(i, 0) = \"14004a\"\r\n                workArray2(i, 9) = \"Safflower oil\"\r\n            Case workArray2(i, 0) = \"14011a\"\r\n                workArray2(i, 9) = \"Sunflower oil\"\r\n            Case workArray2(i, 0) = \"14011b\"\r\n                workArray2(i, 9) = \"Sunflower oil\"\r\n        End Select\r\n    Next r\r\nNext i\r\nReDim workArray3(UBound(workArray2), UBound(workArray2, 2))\r\nFor i = LBound(workArray3) To UBound(workArray3)\r\n    workArray3(i, 0) = workArray2(i, 0)\r\n    workArray3(i, 1) = workArray2(i, 1)\r\n    workArray3(i, 2) = workArray2(i, 2)\r\n    workArray3(i, 3) = workArray2(i, 4)\r\n    workArray3(i, 4) = workArray2(i, 6)\r\n    workArray3(i, 5) = workArray2(i, 8)\r\n    workArray3(i, 6) = workArray2(i, 10)\r\n    workArray3(i, 7) = workArray2(i, 12)\r\n    workArray3(i, 8) = workArray2(i, 14)\r\n    workArray3(i, 9) = workArray2(i, 3)\r\n    workArray3(i, 10) = workArray2(i, 5)\r\n    workArray3(i, 11) = workArray2(i, 7)\r\n    workArray3(i, 12) = workArray2(i, 16)\r\n    workArray3(i, 13) = workArray2(i, 9)\r\n    workArray3(i, 14) = workArray2(i, 11)\r\n    workArray3(i, 15) = workArray2(i, 13)\r\n    workArray3(i, 16) = workArray2(i, 15)\r\nNext i\r\nSet mySht = Worksheets.Add\r\nWith mySht\r\n    .Name = \"M_CATEGORY\"\r\n    .Range(\"A1\").Value = \"ItemNumber\"\r\n    .Range(\"B1\").Value = \"FoodGroupNumber\"\r\n    .Range(\"C1\").Value = \"FoodGroupJP\"\r\n    .Range(\"D1\").Value = \"SubGroupJP\"\r\n    .Range(\"E1\").Value = \"SubCategoryJP\"\r\n    .Range(\"F1\").Value = \"MajorCategoryJP\"\r\n    .Range(\"G1\").Value = \"MediumCategoryJP\"\r\n    .Range(\"H1\").Value = \"MinorCategoryJP\"\r\n    .Range(\"I1\").Value = \"DetailsJP\"\r\n    .Range(\"J1\").Value = \"FoodGroupEN\"\r\n    .Range(\"K1\").Value = \"SubGroupEN\"\r\n    .Range(\"L1\").Value = \"SubCategoryEN\"\r\n    .Range(\"M1\").Value = \"AcademicName\"\r\n    .Range(\"N1\").Value = \"MajorCategoryEN\"\r\n    .Range(\"O1\").Value = \"MediumCategoryEN\"\r\n    .Range(\"P1\").Value = \"MinorCategoryEN\"\r\n    .Range(\"Q1\").Value = \"DetailsEN\"\r\n    .Range(\"A2:Q1892\") = workArray3\r\nEnd With\r\nSet tmpSht = Nothing\r\nSet tmpRng = Nothing\r\nSet tmpArray = Nothing\r\nSet workArray = Nothing\r\nSet RegExp_Japanese = Nothing\r\nSet RegExp_English = Nothing\r\nSet RegExp_ItemNum = Nothing\r\nSet RegExp_Square_Start = Nothing\r\nSet RegExp_SquareExitEN = Nothing\r\nSet RegExp_RoundStartJP = Nothing\r\nSet RegExp_RoundStartEN = Nothing\r\nSet RegExp_RoundExitEN = Nothing\r\nErase Item_Number()\r\nErase JapaneseItem()\r\nErase EnglishItem()\r\nErase JapaneseClass()\r\nErase English_Class()\r\nErase ItemNumArray()\r\nErase ItemENGArray()\r\nErase ClassArrayJP()\r\nErase ClassArrayEN()\r\nErase SubClassJapanese()\r\nErase SubClass_English()\r\nErase MidleClassJP()\r\nErase MidleClassEN()\r\nErase SubClass_JPN()\r\nErase SubClass_ENG()\r\nErase workArray2()\r\nErase workArray3()\r\nSet mySht = Nothing\r\nSet myRng = Nothing\r\nSet myAr = Nothing\r\nSet mySht2 = Nothing\r\nSet myRng2 = Nothing\r\nSet myAr2 = Nothing\r\nEnd Sub\r\n\r\nFunction NoCancelArray(ByRef Sh As Variant) As Variant\r\nDim mySht           As Variant\r\nDim myRng           As Range\r\nDim tmpAr           As Variant\r\nDim i               As Long\r\nDim j               As Long\r\nDim RegExpCancel    As Object\r\nDim RegExp_Exit     As Object\r\nConst StrCancel     As String = \"^(1\\)|residues)$\"\r\nDim CancelItem()    As String\r\nDim CancelRow1()    As String\r\nDim CancelRow2()    As String\r\nDim myCancelAr()    As String\r\nDim Cancel_Array()  As String\r\n    Set RegExpCancel = CreateObject(\"VBScript.RegExp\")\r\n    With RegExpCancel\r\n        .Pattern = StrCancel\r\n        .IgnoreCase = True\r\n        .Global = True\r\n    End With\r\ntmpAr = Sh\r\nj = 0\r\nFor i = LBound(tmpAr) To UBound(tmpAr)\r\n    If RegExpCancel.Test(tmpAr(i, 1)) Then\r\n        ReDim Preserve CancelItem(j)\r\n        ReDim Preserve CancelRow1(i)\r\n        CancelItem(j) = tmpAr(i, 1)\r\n        CancelRow1(j) = i\r\n        j = j + 1\r\n    End If\r\nNext i\r\nReDim myCancelAr(UBound(CancelItem), 1)\r\nFor j = LBound(myCancelAr) To UBound(myCancelAr)\r\n    myCancelAr(j, 0) = CancelItem(j)\r\n    myCancelAr(j, 1) = CancelRow1(j)\r\nNext j\r\nReDim Preserve myCancelAr(UBound(myCancelAr), 2)\r\nj = 0\r\nFor i = LBound(myCancelAr) To UBound(myCancelAr) - 1\r\n    If myCancelAr(i, 0) = \"1)\" Then\r\n        If UBound(myCancelAr) >= 2 Then\r\n            If myCancelAr(i + 2, 0) = \"residues\" Then\r\n                myCancelAr(i, 2) = myCancelAr(i + 2, 1)\r\n            Else\r\n                myCancelAr(i, 2) = myCancelAr(i + 1, 1)\r\n            End If\r\n        Else\r\n            myCancelAr(i, 2) = myCancelAr(i + 1, 1)\r\n        End If\r\n        j = j + 1\r\n    End If\r\nNext i\r\nErase CancelRow1\r\nj = 0\r\nReDim CancelRow1(j)\r\nReDim CancelRow2(j)\r\nCancelRow1(j) = myCancelAr(j, 1)\r\nCancelRow2(j) = myCancelAr(j, 2)\r\nFor i = LBound(myCancelAr) + 1 To UBound(myCancelAr)\r\n    If myCancelAr(i, 0) = \"1)\" And _\r\n       myCancelAr(i - 1, 0) <> \"1)\" Then\r\n        j = j + 1\r\n        ReDim Preserve CancelRow1(j)\r\n        ReDim Preserve CancelRow2(j)\r\n        CancelRow1(j) = myCancelAr(i, 1)\r\n        CancelRow2(j) = myCancelAr(i, 2)\r\n    End If\r\nNext i\r\nReDim Cancel_Array(UBound(CancelRow1), 1)\r\nj = 0\r\nFor j = LBound(Cancel_Array) To UBound(Cancel_Array)\r\n    Cancel_Array(j, 0) = CancelRow1(j)\r\n    Cancel_Array(j, 1) = CancelRow2(j)\r\nNext j\r\nj = 0\r\nCancel_Array(j, 0) = 1\r\nCancel_Array(j, 1) = CancelRow1(j)\r\nFor j = LBound(Cancel_Array) + 1 To UBound(Cancel_Array)\r\n    Cancel_Array(j, 0) = CancelRow2(j - 1) + 1\r\n    Cancel_Array(j, 1) = CancelRow1(j) - 1\r\nNext j\r\nNoCancelArray = Cancel_Array\r\nEnd Function\r\n<\/pre>\n<p>I have counted number of modified cells. It was more than 2400. I could not write complete code without manual processing.  It is the responsibility of the Ministry of Education, Culture, Sports, Science &#038; Technology in Japan (MEXT).  <\/p>\n<p>References:<br \/>\n<a href=\"\/\/fujiitoshiki.com\/improvesociety\/?p=507\" target=\"_blank\">CSV file of the \u2018Standard Tables of Food Composition in Japan 2010\u2032<\/a><br \/>\n<a href=\"\/\/fujiitoshiki.com\/improvesociety\/?p=439\" target=\"_blank\">Classify the Item_Number of the \u2018Standard Tables of Food Composition in Japan 2010\u2032, Part 1<\/a><\/p>\n<\/div>","protected":false},"excerpt":{"rendered":"<p>According to the article, download the PDF files &#8216;1299012_1.pdf&#8217; to &#8216;1299012_18.pdf&#8217;.  &hellip; <a href=\"https:\/\/www.fujiitoshiki.com\/improvesociety\/?p=456\" class=\"more-link\"><span class=\"screen-reader-text\">&#8220;Classify the Item_Number of the \u2018Standard Tables of Food Composition in Japan 2010\u2032, Part 2&#8221; \u306e<\/span>\u7d9a\u304d\u3092\u8aad\u3080<\/a><\/p>\n","protected":false},"author":1,"featured_media":6026,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_crdt_document":"","_monsterinsights_skip_tracking":false,"_monsterinsights_sitenote_active":false,"_monsterinsights_sitenote_note":"","_monsterinsights_sitenote_category":0,"footnotes":""},"categories":[6,4],"tags":[278,603,277,153],"class_list":["post-456","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-excel","category-nutrition","tag-category","tag-excel","tag-standard-tables-of-food-composition-in-japan-2010","tag-vba"],"aioseo_notices":[],"_links":{"self":[{"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=\/wp\/v2\/posts\/456","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=456"}],"version-history":[{"count":37,"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=\/wp\/v2\/posts\/456\/revisions"}],"predecessor-version":[{"id":7703,"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=\/wp\/v2\/posts\/456\/revisions\/7703"}],"wp:featuredmedia":[{"embeddable":true,"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=\/wp\/v2\/media\/6026"}],"wp:attachment":[{"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=456"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=456"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.fujiitoshiki.com\/improvesociety\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=456"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}