Effects of a Mediterranean-Style Diet on Cardiovascular Risk Factors

I have read an article which describes about effect of Mediterranean diet on cardiovascular risk factors. In Mediterranean countries, epidemiological evidence has been shown to low rate of cardiovascular death. It is derived from original diet pattern that people eat olive oil, nuts, vegetables, beans, fishes and red wine and don’t eat red meat, daily products and sweets so much. In this article, authors said that Mediterranean diets supplemented with olive oil or nuts have beneficial effects on such cardiovascular risks as plasma glucose, blood pressure, body weight, lipid profile and inflammatory marker factors compared with a low-fat diet. Although the authors had shown the epidemiological evidence, the discussion lacks the reason why only olive oil has beneficial effect on CRP but nuts doesn’t have.

Effects of a Mediterranean-Style Diet on Cardiovascular Risk Factors

Ramon Estruch, MD, PhD; Miguel A´ngel Marti´nez-Gonza´lez, MD, PhD; Dolores Corella, PhD; Jordi Salas-Salvado´, MD, PhD; Valentina Ruiz-Gutie´rrez, PhD; Mari´a Isabel Covas, PhD; Miguel Fiol, MD, PhD; Enrique Go´mez-Gracia, MD, PhD; Mari Carmen Lo´pez-Sabater, PhD; Ernest Vinyoles, MD, PhD; Fernando Aro´s, MD, PhD; Manuel Conde, MD, PhD; Carlos Lahoz, MD, PhD; Jose´ Lapetra, MD, PhD; Guillermo Sa´ez, MD, PhD; and Emilio Ros, MD, PhD, for the PREDIMED Study Investigators

Background: The Mediterranean diet has been shown to have beneficial effects on cardiovascular risk factors.

Objective: To compare the short-term effects of 2 Mediterranean diets versus those of a low-fat diet on intermediate markers of cardiovascular risk.

Design: Substudy of a multicenter, randomized, primary prevention trial of cardiovascular disease (Prevencio´n con Dieta Mediterra´nea [PREDIMED] Study).

Setting: Primary care centers affiliated with 10 teaching hospitals.

Participants: 772 asymptomatic persons 55 to 80 years of age at high cardiovascular risk who were recruited from October 2003 to March 2004.

Interventions: Participants were assigned to a low-fat diet (n = 257) or to 1 of 2 Mediterranean diets. Those allocated to Mediterranean diets received nutritional education and either free virgin olive oil, 1 liter per week (n = 257), or free nuts, 30 g/d (n = 258). The authors evaluated outcome changes at 3 months.

Measurements: Body weight, blood pressure, lipid profile, glucose levels, and inflammatory molecules.

Results: The completion rate was 99.6%. Compared with the low-fat diet, the 2 Mediterranean diets produced beneficial changes in most outcomes. Compared with the low-fat diet, the mean changes in the Mediterranean diet with olive oil group and the Mediterranean diet with nuts group were – 0.39 mmol/L (95% CI, – 0.70 to – 0.07 mmol/L) and – 0.30 mmol/L (CI, – 0.58 to – 0.01 mmol/L), respectively, for plasma glucose levels; – 5.9 mm Hg (CI, – 8.7 to – 3.1 mm Hg) and – 7.1 mm Hg (CI, – 10.0 to – 4.1 mm Hg), respectively, for systolic blood pressure; and – 0.38 (CI, – 0.55 to – 0.22) and – 0.26 (CI, – 0.42 to – 0.10), respectively, for the cholesterol–high-density lipoprotein cholesterol ratio. The Mediterranean diet with olive oil reduced C-reactive protein levels by 0.54 mg/L (CI, 1.04 to 0.03 mg/L) compared with the low-fat diet.

Limitations: This short-term study did not focus on clinical outcomes. Nutritional education about low-fat diet was less intense than education about Mediterranean diets.

Conclusion: Compared with a low-fat diet, Mediterranean diets supplemented with olive oil or nuts have beneficial effects on cardiovascular risk factors.

Ann Intern Med. 2006; 145: 1-11.

心血管危険因子における地中海料理の効果

 最近読んだ論文の和訳です.地中海沿岸諸国においては心血管疾病の罹患率が低いことが知られています.その理由は独特の食材パターンに由来し,オリーブオイルやナッツ類,野菜類,果実類,豆類,魚類,赤ワインなどを豊富に使用し,肉類や乳製品類,菓子類などの消費が少ないことが理由ではないかと言われています.この論文ではオリーブオイルとナッツ類を補充したら,単に脂肪を制限した群よりも心血管危険因子である血糖値,血圧,体重,脂質組成,炎症性マーカーなどが低下した,と報告しています.ですが惜しいことに,オリーブオイル群では CRP が低下したのにナッツ群ではなぜ低下していないのか,その理由については考察していません.

 考察の丸括弧で囲った数字は参考文献の番号です.日本語訳の瑕疵の責任は私にあります.



心血管危険因子における地中海料理の効果

Ramon Estruch, MD, PhD; Miguel A´ngel Marti´nez-Gonza´lez, MD, PhD; Dolores Corella, PhD; Jordi Salas-Salvado´, MD, PhD; Valentina Ruiz-Gutie´rrez, PhD; Mari´a Isabel Covas, PhD; Miguel Fiol, MD, PhD; Enrique Go´mez-Gracia, MD, PhD; Mari Carmen Lo´pez-Sabater, PhD; Ernest Vinyoles, MD, PhD; Fernando Aro´s, MD, PhD; Manuel Conde, MD, PhD; Carlos Lahoz, MD, PhD; Jose´ Lapetra, MD, PhD; Guillermo Sa´ez, MD, PhD; and Emilio Ros, MD, PhD, for the PREDIMED Study Investigators

背景

地中海料理は心血管危険因子において有益な効果をもたらすことが示されている.

目的

心血管危険因子の中間マーカーで2種類の地中海料理の効果と低脂肪食の効果とを比較した.

設計

多施設共同で無作為化した心血管疾病一次予防試験のサブ研究.

設定

10 の教育病院と提携したプライマリーケアセンター.

参加者

772 名の無症候で 55 歳から 80 歳までの心血管危険の高リスク患者.2003 年 10 月から 2004 年 3 月まで.

介入

参加者は低脂肪食群 (n=257) または2種類の地中海料理のうちの1群に割り付けられた.地中海料理群は栄養教育を受け,それぞれ無料で1週間に1Lずつのバージンオリーブオイル (n=257) か,1日30gのナッツ (n=258) を受け取った.著者らは3ヶ月後に転帰の変化を評価した.

測定項目

体重,血圧,脂質組成,血糖値,炎症分子.

結果

完遂率は 99.6% だった.低脂肪食群と比較して地中海料理2群では大部分の項目で有益な変化が得られた.低脂肪食群と比較して地中海料理群の血糖値平均はオリーブオイル群とナッツ群でそれぞれ -0.39 mmol/L (95% CI, – 0.70 to – 0.07 mmol/L), – 0.30 mmpl/L (CI, – 0.58 to – 0.01 mmol/L)であった.収縮期圧平均はそれぞれ – 5.9 mmHg (CI, – 8.7 to – 3.1 mmHg), – 7.1 mmHg (CI, – 10.0 to – 4.1 mmHg)であった.コレステロール・HDLコレステロール比はそれぞれ – 0.38 (CI, – 0.55 to – 0.22), – 0.26 (CI, – 0.42 to – 0.10) であった.オリーブオイル群の地中海料理群では低脂肪食群と比較して CRP 値が 0.54 mg/L (CI, 1.04 to 0.03 mg/L) 減少した.

限界

この短期間の研究では臨床的転帰には焦点を当てていない.低脂肪食に対する栄養教育は地中海料理の教育よりも強くない.

結論

低脂肪食に比較してオリーブオイルやナッツを添加した地中海料理は心血管危険因子に対して有益な効果をもたらした.

Ann Intern Med. 2006; 145:1-11.

 先進国において心血管疾患は主要な死因であるが,その発生率には著明な地理的差異がある.地中海諸国における冠動脈疾患の発生率の低さは食生活に帰されてきた.ヨーロッパにおけるコホート研究からの最近の知見では,地中海料理との順守性が高いことと死亡率の減少に関係があることを示唆している.小規模な臨床研究では地中海料理やその何らかの要素が血圧を低下させ,脂質組成と内皮機能を改善した.さらに最近の横断的研究と2年間の供給試験では地中海料理の順守が血管の炎症マーカーの減少と関連していることが示された.心血管リスクの代理マーカーへのこれらの有益な効果は生物学的妥当性に疫学的根拠を与えるものであり,地中海料理の保護効果を示唆するものである.

 オリーブオイルは一価不飽和脂肪酸の豊富なソースであり,地中海料理の主要な要素である.バージンオリーブオイルは果実の脂溶性成分,つまりαトコフェロールとフェノール化合物を保持しており,それらには強い抗酸化作用と抗炎症作用がある.ナッツ類もまた地中海料理では典型的であり,好ましい脂肪酸組成を有しており,栄養素に富み,冠動脈疾患リスクに有利な影響を及ぼす他の生物活性化合物,例えば食物繊維,植物ステロール,葉酸,酸化防止剤などに富む.クルミは特にαリノレン酸,植物 n-3 系脂肪酸といった多価不飽和脂肪酸の含有量が多い点で他のナッツ類と異なっており,さらに抗動脈硬化作用を与えてくれる.それゆえ,我々は高リスク参加者に対して2種類の地中海料理の効果を評価するために大規模な供給試験をデザインした.一方にはバージンオリーブオイルを補い,他方にはミックスナッツを補い,それらと低脂肪食群を心血管転帰で比較した.我々は3ヶ月間の介入を行い,最初の772名の試験参加者において心血管リスクの中間マーカーを測定したので報告する.

方法

研究デザイン

 PREDIMED study は大規模,並行群間,多施設,無作為,対照臨床試験で4年間の臨床試験であり,地中海料理の心血管疾患に対する一次予防効果を評価するものである.推定9000名の高リスク参加者が3つの介入試験に割り付けられる予定で,既に5000名以上が採用されている.3つの介入試験とはオリーブオイルを用いた地中海料理,ミックスナッツを用いた地中海料理および低脂肪食である.主要な転帰は心血管死,非致死性心筋梗塞や非致死性脳卒中などの心血管イベントを集計することである.完了予定日は2010年12月である.

 我々は現在の研究を最初の6ヶ月間の間に研究への参加者を募り,3ヶ月間の食事介入によって心血管リスクの代理マーカーへの効果を評価するようにデザインした.参加した 10 施設の倫理委員会はこの研究プロトコルを承認した.

参加者と採用

 2003 年 10 月から 2004 年 3 月まで我々はスペイン全土の10の教育病院と提携したプライマリーケアセンターにいた 930 名の潜在的参加者を選んだ.適格な参加者とは地域在住の男性なら 55 歳から 80 歳まで,女性なら 60 歳から 80 歳まで,2つの基準の内少なくとも1つを満たすことが求められた.すなわち,2型糖尿病であるか,3つ以上の冠動脈疾患の危険因子(現在喫煙している,血圧 140/90 mmHg 以上の高血圧ないしは降圧剤の処方を受けている,LDL コレステロール値が 4.14 mmol/L (160 mg/dL) 以上であるないしは高脂血症薬の処方を受けている,HDL コレステロール値が 1.04 mmol/L (40 mg/dL) 以下である,BMI が 25 kg/m2 以上である,または若年発症の冠動脈疾患の家族歴がある)を有していることである.除外基準は冠動脈疾患の既往があること,何らかの重篤な慢性疾患があること,薬物中毒ないしはアルコール中毒,オリーブオイルやナッツに対するアレルギーまたは不耐症の既往があること,変化モデルの段階に従って食習慣を変更できると予測するのが難しい場合であった.

 プライマリーケア医師は診療録と訪問スクリーニングの参加者の適格性を徹底した.彼らは協力施設に通院する患者の電子カルテから候補者リストを観察し,適合基準に合致しない患者を除外するために診療録を検討した.そして医師らは適格な候補者に電話をかけてスクリーニング訪問に出席するよう招待した.その訪問には 26 項目からなるアンケートが含まれており,医学的状態と適格性に関連する危険因子を問い合わせるものであった.試験への参加を呼びかけた患者のうち 95% が同意した.

無作為化と介入

 訪問スクリーニングの後,コンピュータによって発生させた乱数列を用いて各施設は適格な参加者を3つの食事群の1つに無作為に割り付けた.調整施設が乱数テーブルを作成し,参加者は 50 ブロックに施設,性別,年齢(70 歳未満と 70 歳以上)を調整して無作為に割り付けられた.我々は年齢と性別のサブグループによる対比番号で予め指定した封書を用いてどの介入群への割当てかを隠した.

 基準の検査は 14 項目のアンケートを含み,以前の検証済みアンケートを拡張したものであり,伝統的な地中海料理への順守の程度を評価するものであった.我々は各項目の値を0か1に割り付けた.詳細は付録の Table 1 を参照のこと.我々はまた 137 項目の検証済みの食物の頻度をアンケートで管理した.それはスペイン版ミネソタ余暇時間の身体活動アンケートであり,47 項目にわたる教育や生活スタイル,既往歴,服薬状況についてのアンケートである.我々は身体測定と血圧測定を行い,空腹時の採血及び随時尿の標本を観察した.

 各施設では同じ栄養士が3群への無作為介入を行った.個別の地中海料理の点数の評価を元に,栄養士は参加者に対して 30 分間の個別の食事指導を行い,特定の食物の望ましい摂取頻度を推奨した.我々は低脂肪食群に割り付けられた参加者にあらゆる油脂類の摂取を控えるように指導し,アメリカ心臓病学会のガイドラインに従って刊行されたリーフレットを渡した.総脂肪摂取量としては2つの地中海料理群参加者に与えられた推奨度は,これらの推奨度は反対であった.というのも彼らは例の 14 項目の地中海料理の点数を増やすように指示されており,植物性脂肪と植物性油脂の消費を増やすことも含まれていたからである.

 低脂肪食群に割り付けられた参加者がそれ以上の介入を受けなかったのに比べ,2群の地中海料理に割り付けられた参加者は2通りの方法で更に強い介入に至った.まず彼らは典型的な地中海料理の脂肪に富む食材(オリーブオイルかナッツ)を無料で提供された.割り付け群に従って,参加者は無料のバージンオリーブオイルか,クルミ・ヘーゼルナッツ・アーモンドの無料の小袋を与えられた.バージンオリーブオイルは3ヶ月間で 15 L (1 L/week), ナッツ類はクルミ 1350 g (15 g/d), ヘーゼルナッツ 675 g (7.5 g/d), アーモンド 675 g (7.5 g/d) であった.地中海料理群に対応する参加者の家庭での需要を考慮して順守度を改善するため,余分にオリーブオイルか 1000 g の追加のナッツ類も提供された.我々は参照実験で標準的な方法で使われたオリーブオイルとナッツ類の栄養組成を分析した.付録の Table 2 を参照のこと.2番目に,1週間の封入後に栄養士が1時間に渡って 20 名までの集団指導を行い,それぞれの地中海料理群に別々の指導を行った.各群の指導は有益な話と先述の物資からなり,具体的には典型的な地中海料理の食材についての詳細な説明,季節の買い物リスト,食事プラン,料理のレシピなどであった.試験全体を通して,全参加者が無料で継続的に施設の栄養士への面会が可能であり,指導と相談を受けることができた.

測定項目

 訓練された職員が構成済み体重計と壁掛式身長計で体重と身長を測定した.また最低肋骨と腸骨稜との中間でウエスト周囲径を身体測定テープで測定した.血圧は校正済み半自動オシロメーター(オムロン HEM-705CP, Hoofddorp, オランダ)で測定した.我々はスペイン食品成分表でエネルギーと栄養組成を計算した.3ヶ月時点での訪問と参加者から相談を受けた時点で栄養士は症状の管理チェックリストを用いて介入の副作用を評価し,回避方法を指導した.そのチェックリストは口腔症状を含み,鼓腸,腹部膨満,消化不良などであり,排便習慣を変更することや他のいかなる食事関連症状も網羅していた.

 血清や EDTA 血漿,尿といった検体はコード化され,中央検査施設に出荷され,分析までの間 – 80 度で保存された.臨床研究者や検査技師はこの試験からは盲検化されていた.必要に応じて全血清または血漿の凍結サンプルの参加者ごとに決められた分析対象成分は以下のとおり.血糖値はグルコースオキシダーゼ法,血清インスリン値はラジオイムノアッセイ法,コレステロールと中性脂肪は酵素処理法,HDL コレステロールはリンタングステン酸と塩化マグネシウムによる沈殿法,アポリポ蛋白 A1 と B は比濁法,ICAM-1, VCAM-1, IL-6 は標準酵素結合免疫吸着アッセイ法,高感度 CRP は粒子強化免疫比濁法.すべての検査項目の測定は二重化した.インスリン,CRP, ICAM-1, VCAM-1, IL-6 のアッセイ内アッセイ間変動係数はそれぞれ 1.8 % – 5.4 %, 0.9 % – 9.9 % の範囲であった.

 糖尿病ではない参加者において,我々は HOMA index を用いてインスリン抵抗性を計算した.

 インスリン抵抗性 = 空腹時インスリン値 (microU/mL) × 空腹時血糖値 (mmol/L) / 22.5

 273 名 (35%) のランダムサンプリングにおいて,我々は尿中チロソールおよび尿中ヒドロキシチロソール値をガスクロマトグラフィー質量分析法で測定し,バージンオリーブオイル摂取の順守のマーカーとした.また同様に血漿αリノレン酸濃度をガスクロマトグラフィー法で測定し,ナッツ(クルミ)摂取の順守の指標とした.

統計解析

 並列デザインとして,統計的検出力の計算は1群ごとに 227 名の参加者が LDL コレステロール値の平均値で 0.13 mmol/L (SD 0.49) (5 mg/L) の差異を検出する必要があることを示唆していた (α = 0.05, power = 0.8).我々は標本サイズを設定するために LDL コレステロールを用いたのだが,同様に予備試験と非確認試験での全 end point での変化に関心があった.我々の解析は治療意思原則に基づいていた.我々は参加者の基本特性の記述統計に平均値と標準偏差を用いた.検査値を解析するのに2つの基本統計量を用いた.つまりベースライン値としての2つの基本統計量と,最終値としての3ヶ月の介入後の2つの基本統計量である.CRP, VCAM-1, ICAM-1 の値を解析するのに自然対数の傾斜分布に変換した.3ヶ月間で臨床,食事,検査値の変化を検査した.それには多変数モデルの層別化因子としての施設も含まれた.交絡の可能性として年齢,性別,基準体重を調整し,これらの変数も多変数モデルに導入した.次の参加者は除外した.つまり先述した食事頻度アンケート調査でも述べたが,カロリー摂取が想定範囲外,つまり1日 500 kcal から 3500 kcal の範囲外にある女性と,1日 800 kcal から 4000 kcal の範囲外の男性.それに加えて CRP 値がいずれかの時点でも 10 mg/L (1 mg/dL) より高い参加者.これは何らかの炎症過程を示唆しており,炎症マーカーの統計解析から除外した.群内および群間の差異は平均値と 95% 信頼区間で示した.すべての統計試験は両側検定であり,有意水準は 0.05 とした.SPSS version 11.0 (SPSS, Chicago, Illinois) を用いて解析を行った.

資金源の役割

 本研究ではスペイン保健省の助成金を受けた (Red G03/140).Fundacion Patrimonio Comunal Olivarero and Hojiblanca SA, California Walnut Commission, Borges SA, そして Morella Nuts SA が寛大にもオリーブオイル,クルミ,アーモンド,ヘーゼルナッツをそれぞれ寄付してくれ,それらを試験に使用した.資金源は研究デザインや収集,解析,データの解釈,刊行における原稿提出決定には関与していない.

結果

 930 名の適格な参加者のうち 158 名を無作為化の前に様々な理由で除外した (Figure 1).Table 1 に本研究に参加した 772 名の参加者の基本特性を示した.参加者のうち 697 名はスペイン系ヨーロッパ人種で 75 名は中南部アメリカからのヒスパニック系移民であった.この試験が継続中にもかかわらず,大規模ブロックサイズの大規模多施設試験なのだが,例の群は出身種族,人口統計学的特性,肥満,危険因子で調整しなおした.3 名が試験完了前に脱落した.その基本特性は群全体のそれとよく似ていた.

副作用

 ナッツの地中海料理群の 34 名 (13 %) の参加者ではホールナッツを噛むのが難しく,歯の間にナッツの破片が挟まったと報告された.この問題はナッツを細かく砕いて低脂肪ヨーグルトに混ぜることで満足に解決した.しかし 1 名の参加者は試験から脱落した.オリーブオイルの地中海料理と低脂肪食に割り付けられた参加者には全く副作用は見られなかった.

食事,エネルギー,栄養の摂取

 次の参加者を除外した.つまり食事,エネルギー,栄養素の計算で非現実的な報告をした参加者である.オリーブオイル群で 21 名,ナッツ群で 19 名,低脂肪食群で 8 名.食事内容の主な変化として,バージンオリーブオイルとナッツの消費量が地中海料理群でそれぞれ提供された食材に対応して大幅に増加した.逆にオリーブオイル群では一般のオリーブオイルの消費が減少した.参加者は一般のオリーブオイルを色々と提供されたバージンオリーブオイルに置き換えたと示唆された.低脂肪食群ではオリーブオイルとナッツの摂取は共に減少したが,統計的有意ではなかった.3群いずれの参加者でも摂取が増加したのは野菜類,豆類,果実類,魚類であり,減少したのは肉類,菓子類,乳製品類であった (Table 2).地中海料理の点数は地中海料理の2群で増加し,低脂肪食群で変化しないままだった.この結果は,エネルギー消費が計算の範囲外の参加者を含めても変化しなかった.

 身体活動による推定エネルギー支出は 3 群内でベースライン値と3ヶ月後で近似していた(データは示さない).オリーブオイルと低脂肪食に割り付けられた群において報告書でのエネルギー摂取の削減が観察された (Table 3).その 3 群では飽和脂肪酸の摂取がベースライン値から減少していた.地中海料理の2群ではコレステロール摂取が減少していた.ナッツ類の地中海料理群では総炭水化物摂取量の減少,食物繊維・総脂質・一価不飽和脂肪酸・多価不飽和脂肪酸の摂取が増加していた.

 本試験での参加者の 273 名の無作為抽出群での血漿及び尿中生化学検査では,地中海料理群での補助食品の順守は良好と判明した.低脂肪食群と比較して,オリーブオイルに割り付けられた群では尿中チロソールおよびヒドロキシチロソールがベースライン値より 19 ng/mL (95% CI, 5 – 35 ng/mL), 84 ng/mL (CI, 34 – 135 ng/mL) それぞれ上昇していた.ナッツ類に割り付けられた群では血漿αリノレン酸値が 0.15 mol% (CI, 0.09 – 0.21 mol%) 上昇していた.

 Table 4 には心血管危険因子を示す.体重と肥満度は 3 群いずれもわずかに減少したが,群間での差異は認められず,統計的有意であったのは低脂肪食群での BMI の変化のみであった.低脂肪食群と比較して地中海料理群での収縮期圧と拡張期圧の低下,血糖値の低下,コレステロール対 HDL コレステロール比の低下,HDL コレステロール値の上昇が認められた.空腹時インスリン値と HOMA index もまた地中海料理2群においてより低値であった.総コレステロール値および中性脂肪値はナッツ群においてのみ減少が認められた.

炎症マーカー

 少なくとも1回以上血漿 CRP 値が 10 mg/L より高かったため,オリーブオイル群から8名,ナッツ群から2名,低脂肪食群から4名の参加者を計算から除外した.Figure 2 に3群での CRP, IL-6, ICAM-1, VCAM-1 のベースライン値からの変化を示す.CRP 値はオリーブオイル群においてのみ減少が認められた.低脂肪食群と比較して,群間調整したオリーブオイル群での CRP 値の変化は – 0.54 mg/L (CI, – 1.04 to – 0.03 mg/L) であり,ナッツ群においては 0.33 mg/L (CI, – 0.19 to 0.84 mg/L) であった.循環血漿中の IL-6, ICAM-1, VCAM-1 濃度は地中海料理2群において共に減少し,低脂肪食群において増加していた.低脂肪食群と比較して.群間での IL-6 値の変化はオリーブオイル群で – 1.6 ng/L (CI, – 2.5 to – 0.6 ng/L), ナッツ群で – 1.3 ng/L (CI, – 2.3 to – 0.4 ng/L) であった.ICAM-1 値の群間変化はそれぞれ – 104 ng/mL (CI, – 135 to – 72 ng/mL), – 97 ng/mL (CI, – 128 to – 65 ng/mL) であった.VCAM-1 値の群間変化はそれぞれ – 178 ng/mL (CI, – 277 to – 79 ng/mL), – 167 ng/mL (- 267 to – 68 ng/mL) であった.CRP 値が 10 mg/L より高い参加者を計算に含めても,食事群の間での CRP 値の差異は拡大したが,統計的有意は変化しなかった.これは他の炎症性分子についても影響しなかった.

サブグループ解析

 本試験のいずれの群のサブグループ(施設,人種,性別,年齢,基準体重,身体活動)においても転帰に差異は全く認められなかった.しかしながら,高血圧を伴う参加者には次の統計的有意差が見られた.つまり,地中海料理の2群において収縮期圧のより大きなベースライン値からの低下である.オリープオイル群,ナッツ群でそれぞれ平均 – 6.2 mmHg (CI, – 8.4 to – 4.0 mmHg), – 7.4 mmHg (CI, – 9.9 mmHg to – 5.0 mmHg).低脂肪食群で高血圧を伴う参加者は平均で 1.2 mmHg (CI, – 1.0 to 3.4 mmHg) であった.正常血圧の参加者の収縮期圧の平均変化は低脂肪食群,オリーブオイル群,ナッツ群でそれぞれ – 1.8 mmHg (CI, – 6.7 to 3.0 mmHg), 0.5 mmHg (CI, – 1.4 to 2.5 mmHg), – 2.2 mmHg (CI, – 4.5 to 0.1 mmHg) であった.データは示さないが,拡張期圧の変化も血圧の変化に伴い同様の傾向を示した.

考察

 もし地中海料理が心血管一次予防に有用なら,個人が食事を遵守することで動脈硬化の危険因子を減らすことに一つの期待が持てるだろう.本試験では高リスクの参加者が栄養指導を受けた後バージンオリーブオイルかナッツ類の提供を受けて基準の地中海料理を改善したところ,低脂肪食群に割り付けられた参加者と比較して血圧の低下,脂質組成の改善,インスリン抵抗性の改善,炎症性分子の減少を示した.

 地中海料理は高脂肪食である.地中海文化では大量の一価不飽和脂肪酸を含有するオリーブオイルを使用するためである.心血管危険因子,肥満,糖尿病に対して,相対的に一価不飽和脂肪酸に富む料理の有効性が科学的に論じられてきた(付録 Table 3 参照のこと).しかしながら,肥満の人に対して栄養指導がなされる時,臨床医はまだ従来の(そしておいしくない)低脂肪食に替わるものとして高脂肪の一価不飽和脂肪酸に富む食事を勧めるのを渋っている.彼らは脂肪が余分のエネルギーを提供し,肥満を助長すると信じている.本試験では多くの参加者が肥満か糖尿病を有していたため,オリーブオイルやナッツなどの大量の一価不飽和脂肪酸を含む食事を自由に摂取した時でも体重増加がなかったという結果は心強いものであった.この結果もまたナッツ類に富む食事は体重を増加させないという根拠に加わるものである (32-34).

 健康食品や生活スタイルは高血圧を予防し治療するにあたって非常に重要である (35).本試験では,既に降圧剤投与を受けている高血圧参加者においても,地中海料理は統計的有意差をもって血圧を低下させた.観察試験 (36, 37) と小規模提供試験 (38, 39) においてオリーブオイルの消費量の増加は血圧を下げるのに役立つことを示唆している (40).最近では Omni Heart study (41) においても色々な食材由来の一価不飽和脂肪酸に富む食事は降圧効果を発揮することが報告されている.小規模試験ではナッツ類に富む食事には全く降圧効果は認められていない (15).しかしながら,クルミには血管作動活性において望ましい効果があるようである (42).更に,大規模横断試験 (43) において,αリノレン酸の摂取は,クルミに豊富に含まれる植物 n-3 脂肪酸なのだが,血圧と反比例していた.ナッツ類の地中海料理の参加者はαリノレン酸摂取が増加しており,平均で 1 g/d であった.故に,クルミの消費も血圧低下に寄与したのであろう.地中海料理の2群において血圧が観察された他の説明として,食物全体のパターンの変化がある.似たパターンとして the Dietary Approaches to Stop Hypertension (DASH) trial (44) があり,これは高用量のオリーブオイルを例外としている.我々の試験では塩分制限はなされていない.地中海料理における血圧低下効果は DASH 料理の塩分非制限群と似ており,DASH 料理の塩分制限群よりも効果は低かった (45).OmniHeart study における効果は偉大だが,炭水化物を部分的に一価不飽和脂肪酸で置換した効果と観察された (41).

 2種類の地中海料理は全参加者において空腹時血糖値と空腹時インスリン値の低下に関連しており,糖尿病ではない参加者においてはインスリン抵抗性に関連している.故にメタボリック症候群患者でインスリン感受性に地中海料理が好ましい効果を観察するのを延長した (12).インスリン抵抗性と糖尿病は余剰エネルギー摂取に関連しており,特に飽和脂肪酸と単糖類の形成に関与し,肥満を増加させる (46).従来,糖尿病患者に対しては低脂肪,高炭水化物の食事を指導されてきた.しかしながら,そのような食事では代謝コントロールや悪影響が悪化する.つまり一価不飽和脂肪酸に富む油脂やナッツ類に基づく高脂肪食では観察されなかったような悪影響がである (31).頻回のナッツの摂取は糖尿病リスクと反比例する (47).それに加えて,肉類と乳製品類の摂取減少と食物繊維の摂取増加は,地中海料理の2群で観察されていたが,生活スタイル介入と組み合わせて,糖尿病の発生率を低下させたことが分かった (48, 49).この結果はインスリン抵抗性における健康的な食事のさらなる有効性を支持するものである.

 炭水化物を食事中の脂肪で置換すると中性脂肪と HDL コレステロールが上昇する.一方飽和脂肪酸を一価不飽和脂肪酸に置換すると LDL コレステロールが低下する (50, 51).基準時と3ヶ月後のいずれも総脂肪摂取量は高かったが,3群いずれにおいてもエネルギーの 1% 程度の飽和脂肪酸摂取量の僅かな減少を観察した.しかし低脂肪食群では脂質組成は変化しなかった一方で地中海料理2群では HDL コレステロール値が上昇した.特にオリーブオイルを提供された時にそうだった.色々なナッツ類に富む食事のコレステロール低下効果が確立している (8, 15, 42) 一方で,なぜオリーブオイルをバージンオリーブオイルに置換すると脂質に有効なのかは分かっていない.バージンオリーブオイルに含まれているオリーブオイルの微量成分がその効果を説明できるかもしれず,さらなる研究に値する.低脂肪食は通常 LDL コレステロールと HDL コレステロールの両者を低下させる (52-54) ため,高リスクの個人にとって脂肪に富む地中海料理はよりよい栄養的選択肢になりうる.

 小規模試験においてナッツの消費は血清中性脂肪の減少に繋がらない (15).地中海料理のナッツ群参加者における中性脂肪減少効果はクルミ由来のαリノレン酸の摂取増加に関係しているのかもしれない.横断研究 (55) においてαリノレン酸の消費は中性脂肪濃度の減少と逆の関係にあるからである.

 動脈硬化は炎症性疾患と広くみなされている.疫学研究,臨床研究,実験研究で地中海料理やその食事パターンの要素の幾つか,つまりオリーブオイル (14, 57) やナッツ類 (34, 42),赤ワイン (57, 58) を頻回に消費することは,低炎症状態に関連しており内皮機能を改善する.他の健康的食事パターンの似たような知見が最近報告された (59).我々の観察では地中海料理の2群に割り付けられた参加者において細胞接着分子濃度の低下が見られ,この食事パターンの抗動脈硬化作用を支持するものである.

 我々の試験にはいくつか限界がある.食事指導を確実に遵守することは提供試験では難しい.しかし推奨された食事パターンを遵守することや提供された食品は,自己申告や客観的検査から判断されたように,良いものであった.一方で我々のデザインは,家庭で用意できる食材や普段の実践など,実際の生活状態を再現する点で強度を持っていた.2番目の限界は低脂肪食についての栄養教育が地中海料理についての教育よりも強くないことである.事実,低脂肪食に割り付けられた群においては脂肪摂取量がわずかに減少しただけであった.これは研究デザインが一部の原因であるが,参加者が地中海文化圏に所属していることも原因である.そこでは人々はオリーブオイルを使用するのを好む.低脂肪食は一般的な食事ではないため,この群の参加者もまた健康的な方法で食生活を変更した.それゆえ,地中海料理群と低脂肪食群との間に観察された転帰の差異は提供された食材に起因するのかもしれない.観察期間がたった3ヶ月しかない点は,危険因子の食事介入効果が長期間を要しないことの主な限界とはみなされず (44, 45, 53),順守期間が続くだけ持続するようである (12, 48, 49).

 結論として,我々の結果は以下の点を支持する.疫学研究を通じて観察された地中海料理の健康への効果はもっともらしい機序を通じて発揮される.脂質組成を改善し,血圧やインスリン抵抗性,全身の炎症正マーカーを低下させる.我々の試験期間は短すぎて臨床転帰を扱うことができなかった.PREDIMED trial 全体の長期観察によって最終的に強固なエビデンスが得られるだろう.その間に,冠動脈疾患の高リスク状態にある個人を管理する有用なツールとしての地中海料理を支持する身体の知識は増して行くだろう.

CSV file of the ‘Standard Tables of Food Composition in Japan 2010’

I had posted the article which contains ‘M_FOODS.txt’, which is derived from the ‘Standard Tables of Food Composition in Japan 2010’, on January 12, 2012. The employee of the Ministry of Education, Culture, Sports, Science & Technology in Japan (MEXT) has asked me to inform on my blog of name and unit of each component of ‘M_FOODS.txt’ file. I have added name and unit to table head of CSV file. Then I post it on my blog.

In original PDF files, comma character is used in component as character rather than as delimiter and space character is used as delimiter. Because I could not use comma character as delimiter, I had to use tab character as delimiter. Although we use double quotes as quote with EXCEL, such other program as relational database management software may use single quotes as quote. Therefore, I didn’t use quote at all. When you open this file, don’t double click to open, please. Please use ‘Text file wizard’. In the last tab of wizard, you would had to select ‘string’ data type of first column. If you would not have followed this warning, you could not open correctly and you would be confused why the length of item number is 4 and the first ‘0’ is missing.

This file has 54 columns and 1,881 rows. The first three lines show data structure, following lines from the fourth line show data itself. Japanese name of components in the first line, English name of components in the second line and unit in the third line. It means ‘g’ as gram, ‘mg’ as milligram and ‘microgram’ as micro-gram.

Please note following:

1. I have replaced the strings ‘(0)’, ‘Tr’, ‘(Tr)’ and ‘-‘ with ‘0’.

2. The text file is derived from ‘Standard Tables of Food Composition in Japan 2010’, published by Report of the Subdivision on Resources The Council for Science and Technology, MEXT, JAPAN. Please contact MEXT to obtain application or notification before duplication or reproduction.

E-mail: kagseis@mext.go.jp

M_FOODS.csv

References:
Classify the Item_Number of the ‘Standard Tables of Food Composition in Japan 2010′, Part 1
Classify the Item_Number of the ‘Standard Tables of Food Composition in Japan 2010′, Part 2

日本食品標準成分表2010のcsvファイル

2012年1月12日,日本食品標準成分表2010のテキストデータの記事を投稿しました.その際に’M_FOODS.txt’ファイルに各項目の名称と単位を付記されたいとの依頼があったと追記しました.今回は表頭に各項目名と単位を付記したcsvファイルを作成しましたので公開いたします.

元のPDFファイルでは各要素内にコンマを使用しており,デリミタとしてスペースを使用していました.本ファイルではタブをデリミタとして使用しています.EXCELでは通常ダブルクォーテーションを引用符として用いますが,他のデータベースソフトではシングルクォーテーションを引用符として用いるものもあります.そのため本ファイルでは引用符を使用しておりません.EXCELに取り込む際にはダブルクリックで開かず,必ず’データ’タブの’外部データをインポートする’から’テキストファイル’を選択してください.またテキストファイルウィザードの最後のタブで1列目のデータ型を’文字列’にしてください.以上の注意点を守らない場合,食品番号は通常5桁の数値ですが,先頭の’0’が欠落する場合があります.



本ファイルは54列1881行から成ります.表頭3行はデータ構造を示し,4行目以降が実際のデータです.1行目は日本語の項目名,2行目は英語の項目名,3行目は単位です.gはグラム,mgはミリグラム,microgramはマイクログラムです.

以下の点にご注意ください.

1.「日本食品標準成分表2010」に記載されている,(0),Tr,(Tr),-,について,当データでは「 0 」と表記しています.

2.本表の食品成分値は文部科学省科学技術・学術審議会資源調査分科会報告「日本食品標準成分表2010」によるものです.食品成分値を複製又は転載する場合は事前に文部科学省への許可申請もしくは届け出が必要となる場合があります.

連絡先:文部科学省科学技術・学術政策局政策課資源室 E-mail: kagseis@mext.go.jp

M_FOODS.csv

参照:
日本食品標準成分表2010の食品番号をカテゴリー分類する その1
日本食品標準成分表2010の食品番号をカテゴリー分類する その2

Classify the Item_Number of the ‘Standard Tables of Food Composition in Japan 2010′, Part 1

I have posted the article Classify the Item_Number of the ‘Standard Tables of Food Composition in Japan 2010′ that caused incomplete result. After post it, I have found good article in Japanese. Therefore, I gave it additional value in English.

Standard Tables of Food Composition in Japan 2010

Make a new EXCEL Book. Copy text from the PDF files (‘1299012_1.pdf’ to ‘1299012_18.pdf’) and option paste to EXCEL worksheet ‘Sheet1’ continuously without blank line between the last line of previous text and the first line of next text. With ‘Text File Wizard’, change option data type of the first column to ‘String’. Download Academic name of food materials, select all text and paste to Sheet2. In the first tab of ‘Text File Wizard’, select option ‘The data field separated by delimiters such as comma or tab’. In second tab, remove check mark ‘Consider continuous delimiters as one’. In the last tab, change option data type of the first column to ‘String’. Save as ‘Sample.xlsm’.

Press ‘Alt’ key and ‘F11’ key to launch VBE. Insert module and paste following code. Run ‘Separate_by_Parent’ procedure.

Option Explicit
Function MajorCategoryAr(ByRef Sh As Worksheet) As String()
Dim mySht               As Worksheet
Dim myRng               As Range
Dim tmpAr               As Variant
Dim StartEnd            As Variant
Dim strFoodGroup        As String
Dim strFoodGroupJP      As String
Dim strFoodGroupEN      As String
Dim strSubFoodGroup     As String
Dim strSubFoodGroupJP   As String
Dim strSubFoodGroupEN   As String
Dim strSub_Category     As String
Dim strSub_CategoryJP   As String
Dim strSub_CategoryEN   As String
Dim strMajor_Category   As String
Dim StartNumber()       As String
Dim Exit_Number()       As String
Dim FoodGroupJP()       As String
Dim FoodGroupEN()       As String
Dim Sub_FoodGroup_JP()  As String
Dim Sub_FoodGroup_EN()  As String
Dim Sub_Category_JPN()  As String
Dim Sub_Category_ENG()  As String
Dim Major_CategoryJP()  As String
Dim Major_CategoryEN()  As String
Dim Major_CategoryLT()  As String
Dim myArray()           As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim RegExp_3_Digit_Num  As Object
Dim RegExp_Item_Number  As Object
Dim RegExp_SentakuHanni As Object
Dim RegExp_SubCategory1 As Object
Dim RegExp_SubCategory2 As Object
Dim RegExp_MedCategory  As Object
Dim RegExp_Foods_Group  As Object
Dim RegExp_Jpn_Eng_Mix  As Object
Dim RegExp_JapaneseOnly As Object
Dim RegExp_Upper_Lower  As Object
Dim RegExp_Upper_Only   As Object
Dim RegExp_Lower_Only   As Object
Dim RegExp_RoundBracket As Object
Dim RegExp_SquareBracket    As Object
Dim RegExp_AngleBracket As Object
Dim myMatches           As Object
Dim myMatch             As Object
Const Ptn_3_Digit_Num   As String = "[0-9]{3}$"
Const Ptn_Item_Number   As String = "^[0-9]{5}$"
Const Ptn_SentakuHanni  As String = "(,|~)"
Const Ptn_SubCategory1  As String = "^((|\().()|\))$"
Const Ptn_SubCategory2  As String = "^(<|>)$"
Const Ptn_MedCategory   As String = "^\[.\]$"
Const Ptn_FoodGroupNum  As String = "^([0-9]|[0-9]{2})$"
Const Ptn_Jpn_Eng_Mix   As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
Const Ptn_JapaneseOnly  As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?$"
Const Ptn_Upper_Lower   As String = "[A-Z][a-z]+"
Const Ptn_Upper_Only    As String = "[A-Z]+"
Const Ptn_Lower_Only    As String = "^[a-z]+$"
Const Ptn_RoundStart    As String = "^[\((]"
Const Ptn_Round_Exit    As String = "[\((][^A-Za-z0-9]+[\))]"
Const Ptn_SquareStart   As String = "^\["
Const Ptn_Square_Exit   As String = "\[[^A-Za-z0-9]+\]"
Const Ptn_AngleStart    As String = "^[\<<]"
Const Ptn_Angle_Exit    As String = "[\<<][^A-Za-z0-9]+[\>>]"
Set mySht = Sh
Set myRng = mySht.UsedRange
tmpAr = myRng
Set RegExp_3_Digit_Num = CreateObject("VBScript.RegExp")
Set RegExp_Item_Number = CreateObject("VBScript.RegExp")
Set RegExp_SentakuHanni = CreateObject("VBScript.RegExp")
Set RegExp_SubCategory1 = CreateObject("VBScript.RegExp")
Set RegExp_SubCategory2 = CreateObject("VBScript.RegExp")
Set RegExp_MedCategory = CreateObject("VBScript.RegExp")
Set RegExp_Foods_Group = CreateObject("VBScript.RegExp")
Set RegExp_Jpn_Eng_Mix = CreateObject("VBScript.RegExp")
Set RegExp_JapaneseOnly = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Lower = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Only = CreateObject("VBScript.RegExp")
Set RegExp_Lower_Only = CreateObject("VBScript.RegExp")
Set RegExp_RoundBracket = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket = CreateObject("VBScript.RegExp")
Set RegExp_AngleBracket = CreateObject("VBScript.RegExp")
With RegExp_3_Digit_Num
    .Pattern = "[0-9]{3}$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Item_Number
    .Pattern = "^[0-9]{5}$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_SentakuHanni
    .Pattern = "(,|~)"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_SubCategory1
    .Pattern = "^((|\().()|\))$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_SubCategory2
    .Pattern = "^(<|>)$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_MedCategory
    .Pattern = "^\[.\]$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Foods_Group
    .Pattern = "^([0-9]|[0-9]{2})$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Jpn_Eng_Mix
    .Pattern = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_JapaneseOnly
    .Pattern = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Upper_Lower
    .Pattern = "[A-Z][a-z]+"
    .IgnoreCase = False
    .Global = True
End With
With RegExp_Upper_Only
    .Pattern = "[A-Z]+"
    .IgnoreCase = False
    .Global = True
End With
With RegExp_Lower_Only
    .Pattern = "^[a-z]+$"
    .IgnoreCase = False
    .Global = True
End With
j = 0
For i = LBound(tmpAr) + 1 To UBound(tmpAr)
    With RegExp_RoundBracket
        .Pattern = Ptn_RoundStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket
        .Pattern = Ptn_SquareStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_AngleBracket
        .Pattern = Ptn_AngleStart
        .IgnoreCase = True
        .Global = True
    End With
    strFoodGroup = ""
    strSubFoodGroup = ""
    strSub_Category = ""
    strMajor_Category = ""
    ReDim Preserve StartNumber(j)
    ReDim Preserve Exit_Number(j)
    ReDim Preserve FoodGroupJP(j)
    ReDim Preserve FoodGroupEN(j)
    ReDim Preserve Sub_FoodGroup_JP(j)
    ReDim Preserve Sub_FoodGroup_EN(j)
    ReDim Preserve Sub_Category_JPN(j)
    ReDim Preserve Sub_Category_ENG(j)
    ReDim Preserve Major_CategoryJP(j)
    ReDim Preserve Major_CategoryEN(j)
    ReDim Preserve Major_CategoryLT(j)
    If RegExp_3_Digit_Num.Test(tmpAr(i, 1)) Then
        Select Case True
        Case RegExp_Item_Number.Test(tmpAr(i, 1))
            StartNumber(j) = tmpAr(i, 1)
            Exit_Number(j) = tmpAr(i, 1)
        Case RegExp_SentakuHanni.Test(tmpAr(i, 1))
            StartEnd = StartExit(tmpAr(i, 1))
            StartNumber(j) = StartEnd(0)
            Exit_Number(j) = StartEnd(1)
            Erase StartEnd
        End Select
        FoodGroupJP(j) = strFoodGroupJP
        FoodGroupEN(j) = strFoodGroupEN
        If (i >= 19 And i <= 27) _
        Or (i >= 370 And i <= 596) _
        Or (i >= 599 And i <= 626) _
        Or (i >= 635 And i <= 639) _
        Or (i >= 646 And i <= 668) _
        Then
            Sub_FoodGroup_JP(j) = strSubFoodGroupJP
            Sub_FoodGroup_EN(j) = strSubFoodGroupEN
        End If
        If tmpAr(i, 2) = "" Then
            Sub_Category_JPN(j) = strSub_CategoryJP
            Sub_Category_ENG(j) = strSub_CategoryEN
        End If
        For k = 2 To 8
            strMajor_Category = strMajor_Category & " " & tmpAr(i, k)
        Next k
        strMajor_Category = Trim(strMajor_Category)
        On Error Resume Next
        For k = 1 To 8
            If RegExp_Lower_Only.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_SubCategory1.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_SubCategory2.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_Foods_Group.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_3_Digit_Num.Test(tmpAr(i + 1, 1)) _
            Then
                strMajor_Category = strMajor_Category & " " & tmpAr(i + 1, k)
            End If
        Next k
        On Error GoTo 0
        strMajor_Category = Trim(strMajor_Category)
        If RegExp_Jpn_Eng_Mix.Test(strMajor_Category) Then
            StartEnd = Separate_Jpn_Eng(strMajor_Category)
            Major_CategoryJP(j) = StartEnd(0)
            Erase StartEnd
            Set myMatches = RegExp_Upper_Lower.Execute(strMajor_Category)
            Major_CategoryEN(j) = Mid(strMajor_Category, _
                                    myMatches.Item(0).firstindex + 1, _
                                    myMatches.Item(myMatches.Count - 1).firstindex _
                                  - myMatches.Item(0).firstindex - 1)
            Set myMatch = myMatches.Item(myMatches.Count - 1)
            Major_CategoryLT(j) = Mid(strMajor_Category, myMatch.firstindex + 1)
        Else
        End If
    Else
        Select Case True
        Case RegExp_Foods_Group.Test(tmpAr(i, 1))
            For k = 2 To 8
                strFoodGroup = strFoodGroup & " " & tmpAr(i, k)
            Next k
            strFoodGroup = Trim(strFoodGroup)
            Select Case True
            Case RegExp_Jpn_Eng_Mix.Test(strFoodGroup)
                Set myMatches = RegExp_Jpn_Eng_Mix.Execute(strFoodGroup)
                Set myMatch = myMatches.Item(0)
                strFoodGroupJP = Left(strFoodGroup, myMatches.Item(0).Length - 1)
                strFoodGroupEN = Mid(strFoodGroup, myMatches.Item(0).Length)
            Case RegExp_JapaneseOnly.Test(strFoodGroup)
                Set myMatches = RegExp_JapaneseOnly.Execute(strFoodGroup)
                Set myMatch = myMatches.Item(0)
                strFoodGroupJP = Left(strFoodGroup, myMatches.Item(0).Length - 1)
                strFoodGroupEN = Mid(strFoodGroup, myMatches.Item(0).Length)
            Case Else
            End Select
        Case RegExp_AngleBracket.Test(tmpAr(i, 1))
            For k = 1 To 8
                strSubFoodGroup = strSubFoodGroup & " " & tmpAr(i, k)
            Next k
            strSubFoodGroup = Trim(strSubFoodGroup)
            With RegExp_AngleBracket
                .Pattern = Ptn_Angle_Exit
                .IgnoreCase = True
                .Global = True
            End With
            Set myMatches = RegExp_AngleBracket.Execute(strSubFoodGroup)
            strSubFoodGroupJP = myMatches.Item(0).Value
            strSubFoodGroupEN = Mid(strSubFoodGroup, myMatches.Item(0).Length + 2)
            strSubFoodGroupEN = Replace(strSubFoodGroupEN, "<", "<")
            strSubFoodGroupEN = Replace(strSubFoodGroupEN, ">", ">")
        Case RegExp_RoundBracket.Test(tmpAr(i, 1))
            For k = 1 To 8
                strSub_Category = strSub_Category & " " & tmpAr(i, k)
            Next k
            strSub_Category = Trim(strSub_Category)
            With RegExp_RoundBracket
                .Pattern = Ptn_Round_Exit
                .IgnoreCase = True
                .Global = True
            End With
            Set myMatches = RegExp_RoundBracket.Execute(strSub_Category)
            On Error Resume Next
            strSub_CategoryJP = myMatches.Item(0).Value
            strSub_CategoryJP = Replace(strSub_CategoryJP, "(", "(")
            strSub_CategoryJP = Replace(strSub_CategoryJP, ")", ")")
            strSub_CategoryEN = Mid(strSub_Category, myMatches.Item(0).Length + 2)
            strSub_CategoryEN = Replace(strSub_CategoryEN, "(", "(")
            strSub_CategoryEN = Replace(strSub_CategoryEN, ")", ")")
            On Error GoTo 0
        Case Else
        End Select
        j = j - 1
    End If
    j = j + 1
Next i
ReDim myArray(UBound(StartNumber), 10)
For n = LBound(myArray) To UBound(myArray)
    myArray(n, 0) = StartNumber(n)
    myArray(n, 1) = Exit_Number(n)
    myArray(n, 2) = FoodGroupJP(n)
    myArray(n, 3) = FoodGroupEN(n)
    myArray(n, 4) = Sub_FoodGroup_JP(n)
    myArray(n, 5) = Sub_FoodGroup_EN(n)
    myArray(n, 6) = Sub_Category_JPN(n)
    myArray(n, 7) = Sub_Category_ENG(n)
    myArray(n, 8) = Major_CategoryJP(n)
    myArray(n, 9) = Major_CategoryEN(n)
    myArray(n, 10) = Major_CategoryLT(n)
Next n
MajorCategoryAr = myArray
End Function

Function StartExit(ByVal InputStr As String) As String()
    Dim str     As String
    Dim Ar()    As String
    str = InputStr
    ReDim Ar(1)
    Ar(0) = Left(str, 5)
    Ar(1) = Left(str, 2) & Right(str, 3)
    StartExit = Ar
End Function

Function Separate_Jpn_Eng(ByVal InputStr As String) As String()
    Dim str                 As String
    Dim Ar()                As String
    Dim RegExp_Jpn_Eng_Mix  As Object
    Dim myMatches           As Object
    Dim myMatch             As Object
    Const Ptn_Jpn_Eng_Mix   As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
    str = InputStr
    ReDim Ar(1)
    Set RegExp_Jpn_Eng_Mix = CreateObject("VBScript.RegExp")
    With RegExp_Jpn_Eng_Mix
        .Pattern = Ptn_Jpn_Eng_Mix
        .IgnoreCase = True
        .Global = True
    End With
    Set myMatches = RegExp_Jpn_Eng_Mix.Execute(str)
    For Each myMatch In myMatches
        If myMatches.Count > 0 Then
            Ar(0) = Left(str, myMatches.Item(0).Length - 1)
            Ar(1) = Mid(str, myMatches.Item(0).Length)
        End If
    Next myMatch
    Separate_Jpn_Eng = Ar
End Function

Sub Separate_by_Parent()
Dim mySht1              As Worksheet
Dim mySht2              As Worksheet
Dim mySht3              As Worksheet
Dim myRng               As Range
Dim tmpAr               As Variant
Dim Major_CategoryAr    As Variant
Dim No_Cancel_Ar        As Variant
Dim ItemNamAr()         As String
Dim ItemNumAr()         As String
Dim JapaneseName()      As String
Dim English_Name()      As String
Dim ItemArray()         As String
Dim Residual_JPN()      As String
Dim Residual_ENG()      As String
Dim Residual_Row()      As String
Dim i                   As Long
Dim j                   As Long
Dim k                   As Long
Dim m                   As Long
Dim n                   As Long
Dim p                   As Long
Dim q                   As Long
Dim r                   As Long
Dim s                   As Long
Dim t                   As Long
Dim str_JPN_Analyse     As String
Dim str_ENG_Analyse     As String
Dim strFoodGroup        As String
Dim strFoodGroupJP      As String
Dim strFoodGroupEN      As String
Dim strSubFoodGroup     As String
Dim strSubFoodGroupJP   As String
Dim strSubFoodGroupEN   As String
Dim strSub_Category     As String
Dim strSub_CategoryJP   As String
Dim strSub_CategoryEN   As String
Dim strMajor_Category   As String
Dim strMajor_CategoryJP As String
Dim strMajor_CategoryEN As String
Dim strMediumCategory   As String
Dim strMediumCategoryJP As String
Dim strMediumCategoryEN As String
Dim strMinor_Category   As String
Dim strMinor_CategoryJP As String
Dim strMinor_CategoryEN As String
Dim strDetailCategory   As String
Dim strDetailCategoryJP As String
Dim strDetailCategoryEN As String
Dim FoodGrouNum()       As String
Dim FoodGroupJP()       As String
Dim FoodGroupEN()       As String
Dim Sub_FoodGroup_JP()  As String
Dim Sub_FoodGroup_EN()  As String
Dim Sub_Group_JP_Row()  As String
Dim Sub_Group_EN_Row()  As String
Dim Sub_Category_JPN()  As String
Dim Sub_Category_ENG()  As String
Dim SubCategory_RowJ()  As String
Dim SubCategory_RowE()  As String
Dim Major_CategoryJP()  As String
Dim Major_CategoryEN()  As String
Dim Major_CategoryLT()  As String
Dim Major_JPN_RowNum()  As String
Dim Major_ENG_RowNum()  As String
Dim Major_Temp_Array()  As String
Dim MediumCategoryJP()  As String
Dim MediumCategoryEN()  As String
Dim Med_JP_RowNumber()  As Long
Dim Med_EN_RowNumber()  As Long
Dim Med_Category_JPN()  As String
Dim Med_Category_ENG()  As String
Dim MediumCategoryAr()  As String
Dim Minor_CategoryJP()  As String
Dim Minor_CategoryEN()  As String
Dim Min_JP_RowNumber()  As Long
Dim Min_EN_RowNumber()  As Long
Dim Min_Category_JPN()  As String
Dim Min_Category_ENG()  As String
Dim Minor_CategoryAr()  As String
Dim DetailCategoryJP()  As String
Dim DetailCategoryEN()  As String
Const Ptn_FoodGroupNum  As String = "^([0-9]|[0-9]{2})$"
Const Ptn_Jpn_Eng_Mix   As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
Const Ptn_JapaneseOnly  As String = "^[^A-Za-z0-9\*]+(\([^A-Za-z0-9]+\))?$"
Const Ptn_Upper_Lower   As String = "[A-Za-z\s:\-,]+" '"[A-Za-z,\s]+"
Const Ptn_Upper_Only    As String = "[A-Z]+"
Const Ptn_Lower_Only    As String = "^[a-z]+$"
Const Ptn_AngleStart    As String = "^[\<<]"
Const Ptn_Angle_JPN     As String = "[<<].+[>>]"
Const Ptn_Angle_ENG     As String = "[<<].+[>>]"
Const Ptn_RoundStart    As String = "^[\((][^0-9]+"
Const Ptn_Round_JPN     As String = "[\((][^A-Za-z0-9]+[\))]"
Const Ptn_Round_ENG     As String = "[\((][A-Za-z\s]+[\))]"
Const Ptn_SquareStart   As String = "^\["
Const Ptn_Square_JPN    As String = "\[[^A-Za-z0-9]+\]"
Const Ptn_Square_ENG    As String = "\[[A-Za-z\s:\-,]+(\]|])"
Dim RegExp_MedCategory      As Object
Dim RegExp_Foods_Group      As Object
Dim RegExp_Jpn_Eng_Mix      As Object
Dim RegExp_JapaneseOnly     As Object
Dim RegExp_English_Only     As Object
Dim RegExp_Upper_Lower      As Object
Dim RegExp_Upper_Only       As Object
Dim RegExp_Lower_Only       As Object
Dim RegExp_Angle_Bracket    As Object
Dim RegExp_Angle_Bracket_JP As Object
Dim RegExp_Angle_Bracket_EN As Object
Dim RegExp_Round_Bracket    As Object
Dim RegExp_Round_Bracket_JP As Object
Dim RegExp_Round_Bracket_EN As Object
Dim RegExp_SquareBracket    As Object
Dim RegExp_SquareBracket_JP As Object
Dim RegExp_SquareBracket_EN As Object
Dim RegExp_5_Number     As Object
Dim RegExp_Japanese     As Object
Dim RegExp_Alphabet     As Object
Dim myMatches           As Object
Dim myMatch             As Object
Const Ptn_5_Number      As String = "^[0-9]{5}$"
Const Ptn_Japanese      As String = "[^A-Za-z0-9]{2,}"
Const Ptn_Alphabet      As String = "^[A-Za-z]{2,}"
Dim CEREALS             As Long
Dim POTATOES            As Long
Dim SUGARS              As Long
Dim PULSES              As Long
Dim NUTS                As Long
Dim VEGETABLES          As Long
Dim FRUITS              As Long
Dim MUSHROOMS           As Long
Dim ALGAE               As Long
Dim FISHES              As Long
Dim MEATS               As Long
Dim EGGS                As Long
Dim MILK                As Long
Dim OIL                 As Long
Dim CONFECTIONERIES     As Long
Dim BEVERAGES           As Long
Dim SEASONINGS          As Long
Dim PREPARED            As Long
Dim RegExpJapaneseName  As Object
Const Ptn_JapaneseName  As String = "^([0-9%]{1,3})?[^A-Za-z0-9]+"
Set RegExpJapaneseName = CreateObject("VBScript.RegExp")
With RegExpJapaneseName
    .Pattern = Ptn_JapaneseName
    .IgnoreCase = True
    .Global = True
End With
Dim RegExp_EnglishName  As Object
Dim Ptn_EnglishName   As String
Ptn_EnglishName = "^[A-Za-z0-9%\.,\-'" & ChrW(&HC0) & "-" & ChrW(&HFF) & "]+$"
Set RegExp_EnglishName = CreateObject("VBScript.RegExp")
With RegExp_EnglishName
    .Pattern = Ptn_EnglishName
    .IgnoreCase = True
    .Global = True
End With
Set RegExp_5_Number = CreateObject("VBScript.RegExp")
Set RegExp_MedCategory = CreateObject("VBScript.RegExp")
Set RegExp_Foods_Group = CreateObject("VBScript.RegExp")
Set RegExp_Jpn_Eng_Mix = CreateObject("VBScript.RegExp")
Set RegExp_JapaneseOnly = CreateObject("VBScript.RegExp")
Set RegExp_English_Only = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Lower = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Only = CreateObject("VBScript.RegExp")
Set RegExp_Lower_Only = CreateObject("VBScript.RegExp")
Set RegExp_Angle_Bracket = CreateObject("VBScript.RegExp")
Set RegExp_Angle_Bracket_JP = CreateObject("VBScript.RegExp")
Set RegExp_Angle_Bracket_EN = CreateObject("VBScript.RegExp")
Set RegExp_Round_Bracket = CreateObject("VBScript.RegExp")
Set RegExp_Round_Bracket_JP = CreateObject("VBScript.RegExp")
Set RegExp_Round_Bracket_EN = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket_JP = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket_EN = CreateObject("VBScript.RegExp")
Set RegExp_Japanese = CreateObject("VBScript.RegExp")
Set RegExp_Alphabet = CreateObject("VBScript.RegExp")
    With RegExp_5_Number
        .Pattern = Ptn_5_Number
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Angle_Bracket
        .Pattern = Ptn_AngleStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Angle_Bracket_JP
        .Pattern = Ptn_Angle_JPN
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Angle_Bracket_EN
        .Pattern = Ptn_Angle_ENG
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Round_Bracket
        .Pattern = Ptn_RoundStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Round_Bracket_JP
        .Pattern = Ptn_Round_JPN
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Round_Bracket_EN
        .Pattern = Ptn_Round_ENG
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket
        .Pattern = Ptn_SquareStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket_JP
        .Pattern = Ptn_Square_JPN
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket_EN
        .Pattern = Ptn_Square_ENG
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Japanese
        .Pattern = Ptn_Japanese
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Alphabet
        .Pattern = Ptn_Alphabet
        .IgnoreCase = False
        .Global = True
    End With
    With RegExp_JapaneseOnly
        .Pattern = Ptn_JapaneseOnly
        .IgnoreCase = True
        .Global = True
    End With
Set mySht1 = Worksheets("Sheet1")
Set mySht2 = Worksheets("Sheet2")
Set myRng = mySht1.UsedRange
tmpAr = myRng
Major_CategoryAr = MajorCategoryAr(mySht2)
ReDim Preserve Major_CategoryAr(UBound(Major_CategoryAr), UBound(Major_CategoryAr, 2) + 2)
m = 0
For i = LBound(tmpAr) To UBound(tmpAr)
    For n = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
        If Major_CategoryAr(n, 0) = tmpAr(i, 1) Then
            Major_CategoryAr(n, 11) = i
        End If
        If Major_CategoryAr(n, 1) = tmpAr(i, 1) Then
            Major_CategoryAr(n, 12) = i
        End If
    Next n
Next i
m = 0
n = 0
p = 0
q = 0
No_Cancel_Ar = NoCancelArray(mySht1)
For r = LBound(No_Cancel_Ar) To UBound(No_Cancel_Ar)
For i = No_Cancel_Ar(r, 0) To No_Cancel_Ar(r, 1)
        str_JPN_Analyse = ""
        str_ENG_Analyse = ""
        On Error Resume Next
        For k = 1 To 5
            str_JPN_Analyse = str_JPN_Analyse & tmpAr(i, k)
            str_ENG_Analyse = str_ENG_Analyse & " " & tmpAr(i + 1, k)
            str_ENG_Analyse = Replace(str_ENG_Analyse, "  ", " ")
        Next k
        For k = 1 To 3
            str_ENG_Analyse = str_ENG_Analyse & " " & tmpAr(i + 2, k)
            str_ENG_Analyse = Replace(str_ENG_Analyse, "  ", " ")
        Next k
        On Error GoTo 0
        str_ENG_Analyse = Trim(str_ENG_Analyse)
        Select Case True
        Case RegExp_Angle_Bracket.Test(str_JPN_Analyse) And _
             RegExp_Angle_Bracket.Test(str_ENG_Analyse)
            ReDim Preserve Sub_FoodGroup_JP(p)
            ReDim Preserve Sub_FoodGroup_EN(p)
            ReDim Preserve Sub_Group_JP_Row(p)
            ReDim Preserve Sub_Group_EN_Row(p)
            Set myMatches = RegExp_Angle_Bracket_JP.Execute(str_JPN_Analyse)
            Sub_FoodGroup_JP(p) = myMatches.Item(0).Value
            Sub_Group_JP_Row(p) = i
            Set myMatches = RegExp_Angle_Bracket_EN.Execute(str_ENG_Analyse)
            Sub_FoodGroup_EN(p) = myMatches.Item(0).Value
            Sub_FoodGroup_EN(p) = Replace(Sub_FoodGroup_EN(p), "<", "<")
            Sub_FoodGroup_EN(p) = Replace(Sub_FoodGroup_EN(p), ">", ">")
            Sub_Group_EN_Row(p) = i + 1
            p = p + 1
        Case RegExp_Round_Bracket_JP.Test(str_JPN_Analyse) And _
             RegExp_Round_Bracket_EN.Test(str_ENG_Analyse)
            ReDim Preserve Sub_Category_JPN(n)
            ReDim Preserve Sub_Category_ENG(n)
            ReDim Preserve SubCategory_RowJ(n)
            ReDim Preserve SubCategory_RowE(n)
            Set myMatches = RegExp_Round_Bracket_JP.Execute(str_JPN_Analyse)
            Sub_Category_JPN(n) = myMatches.Item(0).Value
            Sub_Category_JPN(n) = Replace(Sub_Category_JPN(n), "(", "(")
            Sub_Category_JPN(n) = Replace(Sub_Category_JPN(n), ")", ")")
            SubCategory_RowJ(n) = i
            Set myMatches = RegExp_Round_Bracket_EN.Execute(str_ENG_Analyse)
            Sub_Category_ENG(n) = myMatches.Item(0).Value
            Sub_Category_ENG(n) = Replace(Sub_Category_ENG(n), "(", "(")
            Sub_Category_ENG(n) = Replace(Sub_Category_ENG(n), ")", ")")
            SubCategory_RowE(n) = i + 1
            n = n + 1
        Case RegExp_SquareBracket_JP.Test(str_JPN_Analyse) And _
             RegExp_SquareBracket_EN.Test(str_ENG_Analyse)
            ReDim Preserve MediumCategoryJP(m)
            ReDim Preserve Med_JP_RowNumber(m)
            ReDim Preserve MediumCategoryEN(m)
            ReDim Preserve Med_EN_RowNumber(m)
            Set myMatches = RegExp_SquareBracket_JP.Execute(str_JPN_Analyse)
            MediumCategoryJP(m) = myMatches.Item(0).Value
            Med_JP_RowNumber(m) = i
            Set myMatches = RegExp_SquareBracket_EN.Execute(str_ENG_Analyse)
            MediumCategoryEN(m) = myMatches.Item(0).Value
            Med_EN_RowNumber(m) = i + 1
            m = m + 1
        Case RegExp_Japanese.Test(str_JPN_Analyse) And _
             RegExp_Alphabet.Test(str_ENG_Analyse)
            ReDim Preserve Major_CategoryJP(q)
            ReDim Preserve Major_CategoryEN(q)
            ReDim Preserve Major_JPN_RowNum(q)
            ReDim Preserve Major_ENG_RowNum(q)
            Set myMatches = RegExp_Japanese.Execute(str_JPN_Analyse)
            Major_CategoryJP(q) = myMatches.Item(0).Value
            Major_JPN_RowNum(q) = i
            Set myMatches = RegExp_Alphabet.Execute(str_ENG_Analyse)
            Major_CategoryEN(q) = myMatches.Item(0).Value
            Major_ENG_RowNum(q) = i + 1
            q = q + 1
        Case Else
        End Select
Next i
Next r
ReDim Major_Temp_Array(UBound(Major_CategoryJP), 5)
For q = LBound(Major_Temp_Array) To UBound(Major_Temp_Array) - 1
    Major_Temp_Array(q, 0) = Major_CategoryJP(q)
    Major_Temp_Array(q, 1) = Major_JPN_RowNum(q)
    Major_Temp_Array(q, 2) = Major_JPN_RowNum(q + 1)
    Major_Temp_Array(q, 3) = Major_CategoryEN(q)
    Major_Temp_Array(q, 4) = Major_ENG_RowNum(q)
    Major_Temp_Array(q, 5) = Major_ENG_RowNum(q + 1)
Next q
    Major_Temp_Array(q, 0) = Major_CategoryJP(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 1) = Major_JPN_RowNum(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 2) = 32757
    Major_Temp_Array(q, 3) = Major_CategoryEN(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 4) = Major_ENG_RowNum(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 5) = 32757
ReDim MediumCategoryAr(UBound(MediumCategoryJP), 5)
For m = LBound(MediumCategoryAr) To UBound(MediumCategoryAr) - 1
    MediumCategoryAr(m, 0) = MediumCategoryJP(m)
    MediumCategoryAr(m, 1) = Med_JP_RowNumber(m)
    MediumCategoryAr(m, 2) = Med_JP_RowNumber(m + 1)
    MediumCategoryAr(m, 3) = MediumCategoryEN(m)
    MediumCategoryAr(m, 4) = Med_EN_RowNumber(m)
    MediumCategoryAr(m, 5) = Med_EN_RowNumber(m + 1)
Next m
    MediumCategoryAr(m, 0) = MediumCategoryJP(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 1) = Med_JP_RowNumber(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 2) = 26271
    MediumCategoryAr(m, 3) = MediumCategoryEN(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 4) = Med_EN_RowNumber(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 5) = 26271
For m = LBound(MediumCategoryAr) To UBound(MediumCategoryAr)
    For n = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
        If CLng(MediumCategoryAr(m, 1)) > CLng(Major_CategoryAr(n, 11)) And _
           CLng(MediumCategoryAr(m, 1)) < CLng(Major_CategoryAr(n, 12)) And _
           CLng(Major_CategoryAr(n, 12)) < CLng(MediumCategoryAr(m, 2)) Then
            MediumCategoryAr(m, 2) = Major_CategoryAr(n, 12)
        End If
        If CLng(MediumCategoryAr(m, 4)) > CLng(Major_CategoryAr(n, 11)) And _
           CLng(MediumCategoryAr(m, 4)) < CLng(Major_CategoryAr(n, 12)) And _
           CLng(Major_CategoryAr(n, 12)) < CLng(MediumCategoryAr(m, 5)) Then
            MediumCategoryAr(m, 5) = Major_CategoryAr(n, 12)
            Exit For
        End If
    Next n
Next m
p = 0
For i = LBound(tmpAr) To UBound(tmpAr) - 1
    strMinor_CategoryJP = ""
    strMinor_CategoryEN = ""
    For n = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
        If RegExp_JapaneseOnly.Test(tmpAr(i, 1)) And _
       Not RegExp_5_Number.Test(tmpAr(i, 1)) And _
       Not RegExp_Round_Bracket.Test(tmpAr(i, 1)) And _
       Not RegExp_SquareBracket.Test(tmpAr(i, 1)) And _
       Not RegExp_Angle_Bracket.Test(tmpAr(i, 1)) And _
           InStr(tmpAr(i, 1), Major_CategoryAr(n, 8)) <> 0 And _
           InStr(tmpAr(i + 1, 1), Major_CategoryAr(n, 9)) <> 0 And _
           i >= Major_CategoryAr(n, 11) And _
           i <= Major_CategoryAr(n, 12) Then
            ReDim Preserve Minor_CategoryJP(p)
            ReDim Preserve Minor_CategoryEN(p)
            ReDim Preserve Min_JP_RowNumber(p)
            ReDim Preserve Min_EN_RowNumber(p)
            For k = 1 To 2
                strMinor_CategoryJP = strMinor_CategoryJP & tmpAr(i, k)
                strMinor_CategoryEN = strMinor_CategoryEN & " " & tmpAr(i + 1, k)
                strMinor_CategoryEN = Trim(strMinor_CategoryEN)
            Next k
            Set myMatches = RegExp_JapaneseOnly.Execute(strMinor_CategoryJP)
            Minor_CategoryJP(p) = strMinor_CategoryJP
            Min_JP_RowNumber(p) = i
            Set myMatches = RegExp_Upper_Lower.Execute(strMinor_CategoryEN)
            Minor_CategoryEN(p) = strMinor_CategoryEN
            Min_EN_RowNumber(p) = i + 1
            p = p + 1
        Else
        End If
    Next n
Next i
j = 0
For i = LBound(tmpAr) To UBound(tmpAr)
    strFoodGroup = ""
    strSubFoodGroup = ""
    strSub_Category = ""
    strMajor_Category = ""
    strMinor_Category = ""
    strDetailCategory = ""
    If RegExp_5_Number.Test(tmpAr(i, 1)) And tmpAr(i, 2) <> "(欠番)" Then
        ReDim Preserve ItemNamAr(j)
        ReDim Preserve ItemNumAr(j)
        ReDim Preserve FoodGrouNum(j)
        ReDim Preserve FoodGroupJP(j)
        ReDim Preserve FoodGroupEN(j)
        ReDim Preserve Sub_FoodGroup_JP(j)
        ReDim Preserve Sub_FoodGroup_EN(j)
        ReDim Preserve Sub_Category_JPN(j)
        ReDim Preserve Sub_Category_ENG(j)
        ReDim Preserve Major_CategoryJP(j)
        ReDim Preserve Major_CategoryEN(j)
        ReDim Preserve Major_CategoryLT(j)
        ReDim Preserve Med_Category_JPN(j)
        ReDim Preserve Med_Category_ENG(j)
        ReDim Preserve Minor_CategoryJP(j)
        ReDim Preserve Minor_CategoryEN(j)
        ReDim Preserve DetailCategoryJP(j)
        ReDim Preserve DetailCategoryEN(j)
        ReDim Preserve JapaneseName(j)
        ReDim Preserve English_Name(j)
        ItemNamAr(j) = tmpAr(i, 1)
        ItemNumAr(j) = i
        Select Case True
            Case Left(tmpAr(i, 1), 2) = "01"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "穀類"
                FoodGroupEN(j) = "CEREALS"
                CEREALS = CEREALS + 1
            Case Left(tmpAr(i, 1), 2) = "02"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "いも及びでん粉類"
                FoodGroupEN(j) = "POTATOES AND STARCHES"
                POTATOES = POTATOES + 1
            Case Left(tmpAr(i, 1), 2) = "03"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "砂糖及び甘味類"
                FoodGroupEN(j) = "SUGARS"
                SUGARS = SUGARS + 1
            Case Left(tmpAr(i, 1), 2) = "04"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "豆類"
                FoodGroupEN(j) = "PULSES"
                PULSES = PULSES + 1
            Case Left(tmpAr(i, 1), 2) = "05"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "種実類"
                FoodGroupEN(j) = "NUTS AND SEEDS"
                NUTS = NUTS + 1
            Case Left(tmpAr(i, 1), 2) = "06"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "野菜類"
                FoodGroupEN(j) = "VEGETABLES"
                VEGETABLES = VEGETABLES + 1
            Case Left(tmpAr(i, 1), 2) = "07"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "果実類"
                FoodGroupEN(j) = "FRUITS"
                FRUITS = FRUITS + 1
            Case Left(tmpAr(i, 1), 2) = "08"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "きのこ類"
                FoodGroupEN(j) = "MUSHROOMS"
                MUSHROOMS = MUSHROOMS + 1
            Case Left(tmpAr(i, 1), 2) = "09"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "藻類"
                FoodGroupEN(j) = "ALGAE"
                ALGAE = ALGAE + 1
            Case Left(tmpAr(i, 1), 2) = "10"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "魚介類"
                FoodGroupEN(j) = "FISHES AND SHELLFISHES"
                FISHES = FISHES + 1
            Case Left(tmpAr(i, 1), 2) = "11"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "肉類"
                FoodGroupEN(j) = "MEATS"
                MEATS = MEATS + 1
            Case Left(tmpAr(i, 1), 2) = "12"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "卵類"
                FoodGroupEN(j) = "EGGS"
                EGGS = EGGS + 1
            Case Left(tmpAr(i, 1), 2) = "13"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "乳類"
                FoodGroupEN(j) = "MILKS"
                MILK = MILK + 1
            Case Left(tmpAr(i, 1), 2) = "14"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "油脂類"
                FoodGroupEN(j) = "FATS AND OILS"
                OIL = OIL + 1
            Case Left(tmpAr(i, 1), 2) = "15"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "菓子類"
                FoodGroupEN(j) = "CONFECTIONERIES"
                CONFECTIONERIES = CONFECTIONERIES + 1
            Case Left(tmpAr(i, 1), 2) = "16"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "し好飲料類"
                FoodGroupEN(j) = "BEVERAGES"
                BEVERAGES = BEVERAGES + 1
            Case Left(tmpAr(i, 1), 2) = "17"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "調味料及び香辛料類"
                FoodGroupEN(j) = "SEASONINGS AND SPICES"
                SEASONINGS = SEASONINGS + 1
            Case Left(tmpAr(i, 1), 2) = "18"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "調理加工食品類"
                FoodGroupEN(j) = "PREPARED FOODS"
                PREPARED = PREPARED + 1
            Case Else
        End Select
        If RegExpJapaneseName.Test(tmpAr(i, 2)) Then
            Set myMatches = RegExpJapaneseName.Execute(tmpAr(i, 2))
            JapaneseName(j) = myMatches.Item(0).Value
        End If
        For t = 1 To 6
            If RegExp_EnglishName.Test(tmpAr(i + 1, t)) Then
                English_Name(j) = English_Name(j) & " " & tmpAr(i + 1, t)
                English_Name(j) = Trim(English_Name(j))
            Else
                Exit For
            End If
        Next t
        For k = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
            If CLng(tmpAr(i, 1)) >= CLng(Major_CategoryAr(k, 0)) _
           And CLng(tmpAr(i, 1)) <= CLng(Major_CategoryAr(k, 1)) Then
                Sub_FoodGroup_JP(j) = Major_CategoryAr(k, 4)
                Sub_FoodGroup_EN(j) = Major_CategoryAr(k, 5)
                Sub_Category_JPN(j) = Major_CategoryAr(k, 6)
                Sub_Category_ENG(j) = Major_CategoryAr(k, 7)
                Major_CategoryJP(j) = Major_CategoryAr(k, 8)
                Major_CategoryEN(j) = Major_CategoryAr(k, 9)
                Major_CategoryLT(j) = Major_CategoryAr(k, 10)
                For m = LBound(MediumCategoryAr) To UBound(MediumCategoryAr)
                    If i >= CLng(MediumCategoryAr(m, 1)) And _
                       i <= CLng(MediumCategoryAr(m, 2)) Then
                        Med_Category_JPN(j) = MediumCategoryAr(m, 0)
                    End If
                    If i >= CLng(MediumCategoryAr(m, 4)) And _
                       i <= CLng(MediumCategoryAr(m, 5)) Then
                        Med_Category_ENG(j) = MediumCategoryAr(m, 3)
                    End If
                Next m
            Else
            End If
        Next k
    Else
        j = j - 1
    End If
    j = j + 1
Next i
ReDim ItemArray(UBound(ItemNamAr), 14)
For i = LBound(ItemArray) To UBound(ItemArray)
    ItemArray(i, 0) = ItemNamAr(i)
    ItemArray(i, 1) = FoodGrouNum(i)
    ItemArray(i, 2) = FoodGroupJP(i)
    ItemArray(i, 3) = FoodGroupEN(i)
    ItemArray(i, 4) = Sub_FoodGroup_JP(i)
    ItemArray(i, 5) = Sub_FoodGroup_EN(i)
    ItemArray(i, 6) = Sub_Category_JPN(i)
    ItemArray(i, 7) = Sub_Category_ENG(i)
    ItemArray(i, 8) = Major_CategoryJP(i)
    ItemArray(i, 9) = Major_CategoryEN(i)
    ItemArray(i, 10) = Major_CategoryLT(i)
    ItemArray(i, 11) = Med_Category_JPN(i)
    ItemArray(i, 12) = Med_Category_ENG(i)
    ItemArray(i, 13) = JapaneseName(i)
    ItemArray(i, 14) = English_Name(i)
Next i
Set mySht3 = Worksheets.Add
With mySht3
    .Name = "Result"
    .Range("A1").Value = "ItemNumber"
    .Range("B1").Value = "食品群番号"
    .Range("C1").Value = "食品群"
    .Range("D1").Value = "FoodGroup"
    .Range("E1").Value = "副分類"
    .Range("F1").Value = "SubFoodGroup"
    .Range("G1").Value = "区分"
    .Range("H1").Value = "SubCategory"
    .Range("I1").Value = "大分類"
    .Range("J1").Value = "MajorCategory"
    .Range("K1").Value = "AcademicName"
    .Range("L1").Value = "中分類"
    .Range("M1").Value = "MediumCategory"
    .Range("N1").Value = "小分類・細分"
    .Range("O1").Value = "MinorCategory_Details"
    .Range("A2:O1879").Value = ItemArray
End With
End Sub

Function NoCancelArray(ByRef Sh As Worksheet) As Variant
Dim mySht           As Worksheet
Dim myRng           As Range
Dim tmpAr           As Variant
Dim i               As Long
Dim j               As Long
Dim RegExpCancel    As Object
Dim RegExp_Exit     As Object
Const StrCancel     As String = "^(1\)|residues)$"
Dim CancelItem()    As String
Dim CancelRow1()    As String
Dim CancelRow2()    As String
Dim myCancelAr()    As String
Dim Cancel_Array()  As String
Set RegExpCancel = CreateObject("VBScript.RegExp")
With RegExpCancel
    .Pattern = StrCancel
    .IgnoreCase = True
    .Global = True
End With
Set mySht = Sh
Set myRng = mySht.UsedRange
tmpAr = myRng
j = 0
For i = LBound(tmpAr) To UBound(tmpAr)
    If RegExpCancel.Test(tmpAr(i, 1)) Then
        ReDim Preserve CancelItem(j)
        ReDim Preserve CancelRow1(i)
        CancelItem(j) = tmpAr(i, 1)
        CancelRow1(j) = i
        j = j + 1
    End If
Next i
ReDim myCancelAr(UBound(CancelItem), 1)
For j = LBound(myCancelAr) To UBound(myCancelAr)
    myCancelAr(j, 0) = CancelItem(j)
    myCancelAr(j, 1) = CancelRow1(j)
Next j
ReDim Preserve myCancelAr(UBound(myCancelAr), 2)
j = 0
For i = LBound(myCancelAr) To UBound(myCancelAr) - 1
    If myCancelAr(i, 0) = "1)" Then
        If myCancelAr(i + 2, 0) = "residues" Then
            myCancelAr(i, 2) = myCancelAr(i + 2, 1)
        Else
            myCancelAr(i, 2) = myCancelAr(i + 1, 1)
        End If
        j = j + 1
    End If
Next i
Erase CancelRow1
j = 0
ReDim CancelRow1(j)
ReDim CancelRow2(j)
CancelRow1(j) = myCancelAr(j, 1)
CancelRow2(j) = myCancelAr(j, 2)
For i = LBound(myCancelAr) + 1 To UBound(myCancelAr)
    If myCancelAr(i, 0) = "1)" And _
       myCancelAr(i - 1, 0) <> "1)" Then
        j = j + 1
        ReDim Preserve CancelRow1(j)
        ReDim Preserve CancelRow2(j)
        CancelRow1(j) = myCancelAr(i, 1)
        CancelRow2(j) = myCancelAr(i, 2)
    End If
Next i
ReDim Cancel_Array(UBound(CancelRow1), 1)
j = 0
For j = LBound(Cancel_Array) To UBound(Cancel_Array)
    Cancel_Array(j, 0) = CancelRow1(j)
    Cancel_Array(j, 1) = CancelRow2(j)
Next j
j = 0
Cancel_Array(j, 0) = 1
Cancel_Array(j, 1) = CancelRow1(j)
For j = LBound(Cancel_Array) + 1 To UBound(Cancel_Array)
    Cancel_Array(j, 0) = CancelRow2(j - 1)
    Cancel_Array(j, 1) = CancelRow1(j)
Next j
NoCancelArray = Cancel_Array
End Function

References:
CSV file of the ‘Standard Tables of Food Composition in Japan 2010′
Classify the Item_Number of the ‘Standard Tables of Food Composition in Japan 2010′, Part 2

日本食品標準成分表2010の食品番号をカテゴリー分類する その1

日本食品標準成分表2010の食品番号を分類するの記事で食品番号を分類する記事を掲載しましたが,不十分な分類しか出来ておりませんでした.今回は既に日本語の完成した分類を見つけましたので,それを元に英語もつけて分類しました.参考にしたのは以下のファイルです.

資源調査分科会報告「日本食品標準成分表2010」について

新しいブックを用意します.”1299012_1.pdf”から”1299012_18.pdf”までのPDFの全テキストをSheet1にオプションでペーストします.その際,下の行方向に行の間隔を空けずに貼り付けます.テキストファイルウィザードで最初のカラムのデータ形式を『文字列』に変更します.原材料的食品のもととなる生物の学名でダウンロードしたPDFの全テキストを選択し,Sheet2にオプションでペーストします.テキストファイルウィザードが開くので,1/3では元のデータ形式で『カンマやタブなどの区切り文字によってフィールドごとに区切られたデータ』を選択します.テキストファイルウィザード2/3では『連続した区切り文字は1文字とみなす』のチェックを外して次に進みます.テキストファイルウィザード3/3では最初の列のデータ形式を『文字列』に変更して完了をクリックします.このEXCELブックに”Sample.xlsm”と名前を付けて保存します.

“Sample.xlsm”ブックを開き,Alt+F11キーを押下してVBEを起動します.挿入メニューから標準モジュールを選択し,下記のコードを貼り付けます.Separate_by_Parentプロシージャを実行すると”Result”という名前のシートが出来ます.

Option Explicit
Function MajorCategoryAr(ByRef Sh As Worksheet) As String()
Dim mySht               As Worksheet
Dim myRng               As Range
Dim tmpAr               As Variant
Dim StartEnd            As Variant
Dim strFoodGroup        As String
Dim strFoodGroupJP      As String
Dim strFoodGroupEN      As String
Dim strSubFoodGroup     As String
Dim strSubFoodGroupJP   As String
Dim strSubFoodGroupEN   As String
Dim strSub_Category     As String
Dim strSub_CategoryJP   As String
Dim strSub_CategoryEN   As String
Dim strMajor_Category   As String
Dim StartNumber()       As String
Dim Exit_Number()       As String
Dim FoodGroupJP()       As String
Dim FoodGroupEN()       As String
Dim Sub_FoodGroup_JP()  As String
Dim Sub_FoodGroup_EN()  As String
Dim Sub_Category_JPN()  As String
Dim Sub_Category_ENG()  As String
Dim Major_CategoryJP()  As String
Dim Major_CategoryEN()  As String
Dim Major_CategoryLT()  As String
Dim myArray()           As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim RegExp_3_Digit_Num  As Object
Dim RegExp_Item_Number  As Object
Dim RegExp_SentakuHanni As Object
Dim RegExp_SubCategory1 As Object
Dim RegExp_SubCategory2 As Object
Dim RegExp_MedCategory  As Object
Dim RegExp_Foods_Group  As Object
Dim RegExp_Jpn_Eng_Mix  As Object
Dim RegExp_JapaneseOnly As Object
Dim RegExp_Upper_Lower  As Object
Dim RegExp_Upper_Only   As Object
Dim RegExp_Lower_Only   As Object
Dim RegExp_RoundBracket As Object
Dim RegExp_SquareBracket    As Object
Dim RegExp_AngleBracket As Object
Dim myMatches           As Object
Dim myMatch             As Object
Const Ptn_3_Digit_Num   As String = "[0-9]{3}$"
Const Ptn_Item_Number   As String = "^[0-9]{5}$"
Const Ptn_SentakuHanni  As String = "(,|~)"
Const Ptn_SubCategory1  As String = "^((|\().()|\))$"
Const Ptn_SubCategory2  As String = "^(<|>)$"
Const Ptn_MedCategory   As String = "^\[.\]$"
Const Ptn_FoodGroupNum  As String = "^([0-9]|[0-9]{2})$"
Const Ptn_Jpn_Eng_Mix   As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
Const Ptn_JapaneseOnly  As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?$"
Const Ptn_Upper_Lower   As String = "[A-Z][a-z]+"
Const Ptn_Upper_Only    As String = "[A-Z]+"
Const Ptn_Lower_Only    As String = "^[a-z]+$"
Const Ptn_RoundStart    As String = "^[\((]"
Const Ptn_Round_Exit    As String = "[\((][^A-Za-z0-9]+[\))]"
Const Ptn_SquareStart   As String = "^\["
Const Ptn_Square_Exit   As String = "\[[^A-Za-z0-9]+\]"
Const Ptn_AngleStart    As String = "^[\<<]"
Const Ptn_Angle_Exit    As String = "[\<<][^A-Za-z0-9]+[\>>]"
Set mySht = Sh
Set myRng = mySht.UsedRange
tmpAr = myRng
Set RegExp_3_Digit_Num = CreateObject("VBScript.RegExp")
Set RegExp_Item_Number = CreateObject("VBScript.RegExp")
Set RegExp_SentakuHanni = CreateObject("VBScript.RegExp")
Set RegExp_SubCategory1 = CreateObject("VBScript.RegExp")
Set RegExp_SubCategory2 = CreateObject("VBScript.RegExp")
Set RegExp_MedCategory = CreateObject("VBScript.RegExp")
Set RegExp_Foods_Group = CreateObject("VBScript.RegExp")
Set RegExp_Jpn_Eng_Mix = CreateObject("VBScript.RegExp")
Set RegExp_JapaneseOnly = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Lower = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Only = CreateObject("VBScript.RegExp")
Set RegExp_Lower_Only = CreateObject("VBScript.RegExp")
Set RegExp_RoundBracket = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket = CreateObject("VBScript.RegExp")
Set RegExp_AngleBracket = CreateObject("VBScript.RegExp")
With RegExp_3_Digit_Num
    .Pattern = "[0-9]{3}$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Item_Number
    .Pattern = "^[0-9]{5}$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_SentakuHanni
    .Pattern = "(,|~)"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_SubCategory1
    .Pattern = "^((|\().()|\))$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_SubCategory2
    .Pattern = "^(<|>)$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_MedCategory
    .Pattern = "^\[.\]$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Foods_Group
    .Pattern = "^([0-9]|[0-9]{2})$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Jpn_Eng_Mix
    .Pattern = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_JapaneseOnly
    .Pattern = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?$"
    .IgnoreCase = True
    .Global = True
End With
With RegExp_Upper_Lower
    .Pattern = "[A-Z][a-z]+"
    .IgnoreCase = False
    .Global = True
End With
With RegExp_Upper_Only
    .Pattern = "[A-Z]+"
    .IgnoreCase = False
    .Global = True
End With
With RegExp_Lower_Only
    .Pattern = "^[a-z]+$"
    .IgnoreCase = False
    .Global = True
End With
j = 0
For i = LBound(tmpAr) + 1 To UBound(tmpAr)
    With RegExp_RoundBracket
        .Pattern = Ptn_RoundStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket
        .Pattern = Ptn_SquareStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_AngleBracket
        .Pattern = Ptn_AngleStart
        .IgnoreCase = True
        .Global = True
    End With
    strFoodGroup = ""
    strSubFoodGroup = ""
    strSub_Category = ""
    strMajor_Category = ""
    ReDim Preserve StartNumber(j)
    ReDim Preserve Exit_Number(j)
    ReDim Preserve FoodGroupJP(j)
    ReDim Preserve FoodGroupEN(j)
    ReDim Preserve Sub_FoodGroup_JP(j)
    ReDim Preserve Sub_FoodGroup_EN(j)
    ReDim Preserve Sub_Category_JPN(j)
    ReDim Preserve Sub_Category_ENG(j)
    ReDim Preserve Major_CategoryJP(j)
    ReDim Preserve Major_CategoryEN(j)
    ReDim Preserve Major_CategoryLT(j)
    If RegExp_3_Digit_Num.Test(tmpAr(i, 1)) Then
        Select Case True
        Case RegExp_Item_Number.Test(tmpAr(i, 1))
            StartNumber(j) = tmpAr(i, 1)
            Exit_Number(j) = tmpAr(i, 1)
        Case RegExp_SentakuHanni.Test(tmpAr(i, 1))
            StartEnd = StartExit(tmpAr(i, 1))
            StartNumber(j) = StartEnd(0)
            Exit_Number(j) = StartEnd(1)
            Erase StartEnd
        End Select
        FoodGroupJP(j) = strFoodGroupJP
        FoodGroupEN(j) = strFoodGroupEN
        If (i >= 19 And i <= 27) _
        Or (i >= 370 And i <= 596) _
        Or (i >= 599 And i <= 626) _
        Or (i >= 635 And i <= 639) _
        Or (i >= 646 And i <= 668) _
        Then
            Sub_FoodGroup_JP(j) = strSubFoodGroupJP
            Sub_FoodGroup_EN(j) = strSubFoodGroupEN
        End If
        If tmpAr(i, 2) = "" Then
            Sub_Category_JPN(j) = strSub_CategoryJP
            Sub_Category_ENG(j) = strSub_CategoryEN
        End If
        For k = 2 To 8
            strMajor_Category = strMajor_Category & " " & tmpAr(i, k)
        Next k
        strMajor_Category = Trim(strMajor_Category)
        On Error Resume Next
        For k = 1 To 8
            If RegExp_Lower_Only.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_SubCategory1.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_SubCategory2.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_Foods_Group.Test(tmpAr(i + 1, 1)) _
            And Not RegExp_3_Digit_Num.Test(tmpAr(i + 1, 1)) _
            Then
                strMajor_Category = strMajor_Category & " " & tmpAr(i + 1, k)
            End If
        Next k
        On Error GoTo 0
        strMajor_Category = Trim(strMajor_Category)
        If RegExp_Jpn_Eng_Mix.Test(strMajor_Category) Then
            StartEnd = Separate_Jpn_Eng(strMajor_Category)
            Major_CategoryJP(j) = StartEnd(0)
            Erase StartEnd
            Set myMatches = RegExp_Upper_Lower.Execute(strMajor_Category)
            Major_CategoryEN(j) = Mid(strMajor_Category, _
                                    myMatches.Item(0).firstindex + 1, _
                                    myMatches.Item(myMatches.Count - 1).firstindex _
                                  - myMatches.Item(0).firstindex - 1)
            Set myMatch = myMatches.Item(myMatches.Count - 1)
            Major_CategoryLT(j) = Mid(strMajor_Category, myMatch.firstindex + 1)
        Else
        End If
    Else
        Select Case True
        Case RegExp_Foods_Group.Test(tmpAr(i, 1))
            For k = 2 To 8
                strFoodGroup = strFoodGroup & " " & tmpAr(i, k)
            Next k
            strFoodGroup = Trim(strFoodGroup)
            Select Case True
            Case RegExp_Jpn_Eng_Mix.Test(strFoodGroup)
                Set myMatches = RegExp_Jpn_Eng_Mix.Execute(strFoodGroup)
                Set myMatch = myMatches.Item(0)
                strFoodGroupJP = Left(strFoodGroup, myMatches.Item(0).Length - 1)
                strFoodGroupEN = Mid(strFoodGroup, myMatches.Item(0).Length)
            Case RegExp_JapaneseOnly.Test(strFoodGroup)
                Set myMatches = RegExp_JapaneseOnly.Execute(strFoodGroup)
                Set myMatch = myMatches.Item(0)
                strFoodGroupJP = Left(strFoodGroup, myMatches.Item(0).Length - 1)
                strFoodGroupEN = Mid(strFoodGroup, myMatches.Item(0).Length)
            Case Else
            End Select
        Case RegExp_AngleBracket.Test(tmpAr(i, 1))
            For k = 1 To 8
                strSubFoodGroup = strSubFoodGroup & " " & tmpAr(i, k)
            Next k
            strSubFoodGroup = Trim(strSubFoodGroup)
            With RegExp_AngleBracket
                .Pattern = Ptn_Angle_Exit
                .IgnoreCase = True
                .Global = True
            End With
            Set myMatches = RegExp_AngleBracket.Execute(strSubFoodGroup)
            strSubFoodGroupJP = myMatches.Item(0).Value
            strSubFoodGroupEN = Mid(strSubFoodGroup, myMatches.Item(0).Length + 2)
            strSubFoodGroupEN = Replace(strSubFoodGroupEN, "<", "<")
            strSubFoodGroupEN = Replace(strSubFoodGroupEN, ">", ">")
        Case RegExp_RoundBracket.Test(tmpAr(i, 1))
            For k = 1 To 8
                strSub_Category = strSub_Category & " " & tmpAr(i, k)
            Next k
            strSub_Category = Trim(strSub_Category)
            With RegExp_RoundBracket
                .Pattern = Ptn_Round_Exit
                .IgnoreCase = True
                .Global = True
            End With
            Set myMatches = RegExp_RoundBracket.Execute(strSub_Category)
            On Error Resume Next
            strSub_CategoryJP = myMatches.Item(0).Value
            strSub_CategoryJP = Replace(strSub_CategoryJP, "(", "(")
            strSub_CategoryJP = Replace(strSub_CategoryJP, ")", ")")
            strSub_CategoryEN = Mid(strSub_Category, myMatches.Item(0).Length + 2)
            strSub_CategoryEN = Replace(strSub_CategoryEN, "(", "(")
            strSub_CategoryEN = Replace(strSub_CategoryEN, ")", ")")
            On Error GoTo 0
        Case Else
        End Select
        j = j - 1
    End If
    j = j + 1
Next i
ReDim myArray(UBound(StartNumber), 10)
For n = LBound(myArray) To UBound(myArray)
    myArray(n, 0) = StartNumber(n)
    myArray(n, 1) = Exit_Number(n)
    myArray(n, 2) = FoodGroupJP(n)
    myArray(n, 3) = FoodGroupEN(n)
    myArray(n, 4) = Sub_FoodGroup_JP(n)
    myArray(n, 5) = Sub_FoodGroup_EN(n)
    myArray(n, 6) = Sub_Category_JPN(n)
    myArray(n, 7) = Sub_Category_ENG(n)
    myArray(n, 8) = Major_CategoryJP(n)
    myArray(n, 9) = Major_CategoryEN(n)
    myArray(n, 10) = Major_CategoryLT(n)
Next n
MajorCategoryAr = myArray
End Function

Function StartExit(ByVal InputStr As String) As String()
    Dim str     As String
    Dim Ar()    As String
    str = InputStr
    ReDim Ar(1)
    Ar(0) = Left(str, 5)
    Ar(1) = Left(str, 2) & Right(str, 3)
    StartExit = Ar
End Function

Function Separate_Jpn_Eng(ByVal InputStr As String) As String()
    Dim str                 As String
    Dim Ar()                As String
    Dim RegExp_Jpn_Eng_Mix  As Object
    Dim myMatches           As Object
    Dim myMatch             As Object
    Const Ptn_Jpn_Eng_Mix   As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
    str = InputStr
    ReDim Ar(1)
    Set RegExp_Jpn_Eng_Mix = CreateObject("VBScript.RegExp")
    With RegExp_Jpn_Eng_Mix
        .Pattern = Ptn_Jpn_Eng_Mix
        .IgnoreCase = True
        .Global = True
    End With
    Set myMatches = RegExp_Jpn_Eng_Mix.Execute(str)
    For Each myMatch In myMatches
        If myMatches.Count > 0 Then
            Ar(0) = Left(str, myMatches.Item(0).Length - 1)
            Ar(1) = Mid(str, myMatches.Item(0).Length)
        End If
    Next myMatch
    Separate_Jpn_Eng = Ar
End Function

Sub Separate_by_Parent()
Dim mySht1              As Worksheet
Dim mySht2              As Worksheet
Dim mySht3              As Worksheet
Dim myRng               As Range
Dim tmpAr               As Variant
Dim Major_CategoryAr    As Variant
Dim No_Cancel_Ar        As Variant
Dim ItemNamAr()         As String
Dim ItemNumAr()         As String
Dim JapaneseName()      As String
Dim English_Name()      As String
Dim ItemArray()         As String
Dim Residual_JPN()      As String
Dim Residual_ENG()      As String
Dim Residual_Row()      As String
Dim i                   As Long
Dim j                   As Long
Dim k                   As Long
Dim m                   As Long
Dim n                   As Long
Dim p                   As Long
Dim q                   As Long
Dim r                   As Long
Dim s                   As Long
Dim t                   As Long
Dim str_JPN_Analyse     As String
Dim str_ENG_Analyse     As String
Dim strFoodGroup        As String
Dim strFoodGroupJP      As String
Dim strFoodGroupEN      As String
Dim strSubFoodGroup     As String
Dim strSubFoodGroupJP   As String
Dim strSubFoodGroupEN   As String
Dim strSub_Category     As String
Dim strSub_CategoryJP   As String
Dim strSub_CategoryEN   As String
Dim strMajor_Category   As String
Dim strMajor_CategoryJP As String
Dim strMajor_CategoryEN As String
Dim strMediumCategory   As String
Dim strMediumCategoryJP As String
Dim strMediumCategoryEN As String
Dim strMinor_Category   As String
Dim strMinor_CategoryJP As String
Dim strMinor_CategoryEN As String
Dim strDetailCategory   As String
Dim strDetailCategoryJP As String
Dim strDetailCategoryEN As String
Dim FoodGrouNum()       As String
Dim FoodGroupJP()       As String
Dim FoodGroupEN()       As String
Dim Sub_FoodGroup_JP()  As String
Dim Sub_FoodGroup_EN()  As String
Dim Sub_Group_JP_Row()  As String
Dim Sub_Group_EN_Row()  As String
Dim Sub_Category_JPN()  As String
Dim Sub_Category_ENG()  As String
Dim SubCategory_RowJ()  As String
Dim SubCategory_RowE()  As String
Dim Major_CategoryJP()  As String
Dim Major_CategoryEN()  As String
Dim Major_CategoryLT()  As String
Dim Major_JPN_RowNum()  As String
Dim Major_ENG_RowNum()  As String
Dim Major_Temp_Array()  As String
Dim MediumCategoryJP()  As String
Dim MediumCategoryEN()  As String
Dim Med_JP_RowNumber()  As Long
Dim Med_EN_RowNumber()  As Long
Dim Med_Category_JPN()  As String
Dim Med_Category_ENG()  As String
Dim MediumCategoryAr()  As String
Dim Minor_CategoryJP()  As String
Dim Minor_CategoryEN()  As String
Dim Min_JP_RowNumber()  As Long
Dim Min_EN_RowNumber()  As Long
Dim Min_Category_JPN()  As String
Dim Min_Category_ENG()  As String
Dim Minor_CategoryAr()  As String
Dim DetailCategoryJP()  As String
Dim DetailCategoryEN()  As String
Const Ptn_FoodGroupNum  As String = "^([0-9]|[0-9]{2})$"
Const Ptn_Jpn_Eng_Mix   As String = "^[^A-Za-z0-9]+(\([^A-Za-z0-9]+\))?([A-Za-z])"
Const Ptn_JapaneseOnly  As String = "^[^A-Za-z0-9\*]+(\([^A-Za-z0-9]+\))?$"
Const Ptn_Upper_Lower   As String = "[A-Za-z\s:\-,]+" '"[A-Za-z,\s]+"
Const Ptn_Upper_Only    As String = "[A-Z]+"
Const Ptn_Lower_Only    As String = "^[a-z]+$"
Const Ptn_AngleStart    As String = "^[\<<]"
Const Ptn_Angle_JPN     As String = "[<<].+[>>]"
Const Ptn_Angle_ENG     As String = "[<<].+[>>]"
Const Ptn_RoundStart    As String = "^[\((][^0-9]+"
Const Ptn_Round_JPN     As String = "[\((][^A-Za-z0-9]+[\))]"
Const Ptn_Round_ENG     As String = "[\((][A-Za-z\s]+[\))]"
Const Ptn_SquareStart   As String = "^\["
Const Ptn_Square_JPN    As String = "\[[^A-Za-z0-9]+\]"
Const Ptn_Square_ENG    As String = "\[[A-Za-z\s:\-,]+(\]|])"
Dim RegExp_MedCategory      As Object
Dim RegExp_Foods_Group      As Object
Dim RegExp_Jpn_Eng_Mix      As Object
Dim RegExp_JapaneseOnly     As Object
Dim RegExp_English_Only     As Object
Dim RegExp_Upper_Lower      As Object
Dim RegExp_Upper_Only       As Object
Dim RegExp_Lower_Only       As Object
Dim RegExp_Angle_Bracket    As Object
Dim RegExp_Angle_Bracket_JP As Object
Dim RegExp_Angle_Bracket_EN As Object
Dim RegExp_Round_Bracket    As Object
Dim RegExp_Round_Bracket_JP As Object
Dim RegExp_Round_Bracket_EN As Object
Dim RegExp_SquareBracket    As Object
Dim RegExp_SquareBracket_JP As Object
Dim RegExp_SquareBracket_EN As Object
Dim RegExp_5_Number     As Object
Dim RegExp_Japanese     As Object
Dim RegExp_Alphabet     As Object
Dim myMatches           As Object
Dim myMatch             As Object
Const Ptn_5_Number      As String = "^[0-9]{5}$"
Const Ptn_Japanese      As String = "[^A-Za-z0-9]{2,}"
Const Ptn_Alphabet      As String = "^[A-Za-z]{2,}"
Dim CEREALS             As Long
Dim POTATOES            As Long
Dim SUGARS              As Long
Dim PULSES              As Long
Dim NUTS                As Long
Dim VEGETABLES          As Long
Dim FRUITS              As Long
Dim MUSHROOMS           As Long
Dim ALGAE               As Long
Dim FISHES              As Long
Dim MEATS               As Long
Dim EGGS                As Long
Dim MILK                As Long
Dim OIL                 As Long
Dim CONFECTIONERIES     As Long
Dim BEVERAGES           As Long
Dim SEASONINGS          As Long
Dim PREPARED            As Long
Dim RegExpJapaneseName  As Object
Const Ptn_JapaneseName  As String = "^([0-9%]{1,3})?[^A-Za-z0-9]+"
Set RegExpJapaneseName = CreateObject("VBScript.RegExp")
With RegExpJapaneseName
    .Pattern = Ptn_JapaneseName
    .IgnoreCase = True
    .Global = True
End With
Dim RegExp_EnglishName  As Object
Dim Ptn_EnglishName   As String
Ptn_EnglishName = "^[A-Za-z0-9%\.,\-'" & ChrW(&HC0) & "-" & ChrW(&HFF) & "]+$"
Set RegExp_EnglishName = CreateObject("VBScript.RegExp")
With RegExp_EnglishName
    .Pattern = Ptn_EnglishName
    .IgnoreCase = True
    .Global = True
End With
Set RegExp_5_Number = CreateObject("VBScript.RegExp")
Set RegExp_MedCategory = CreateObject("VBScript.RegExp")
Set RegExp_Foods_Group = CreateObject("VBScript.RegExp")
Set RegExp_Jpn_Eng_Mix = CreateObject("VBScript.RegExp")
Set RegExp_JapaneseOnly = CreateObject("VBScript.RegExp")
Set RegExp_English_Only = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Lower = CreateObject("VBScript.RegExp")
Set RegExp_Upper_Only = CreateObject("VBScript.RegExp")
Set RegExp_Lower_Only = CreateObject("VBScript.RegExp")
Set RegExp_Angle_Bracket = CreateObject("VBScript.RegExp")
Set RegExp_Angle_Bracket_JP = CreateObject("VBScript.RegExp")
Set RegExp_Angle_Bracket_EN = CreateObject("VBScript.RegExp")
Set RegExp_Round_Bracket = CreateObject("VBScript.RegExp")
Set RegExp_Round_Bracket_JP = CreateObject("VBScript.RegExp")
Set RegExp_Round_Bracket_EN = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket_JP = CreateObject("VBScript.RegExp")
Set RegExp_SquareBracket_EN = CreateObject("VBScript.RegExp")
Set RegExp_Japanese = CreateObject("VBScript.RegExp")
Set RegExp_Alphabet = CreateObject("VBScript.RegExp")
    With RegExp_5_Number
        .Pattern = Ptn_5_Number
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Angle_Bracket
        .Pattern = Ptn_AngleStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Angle_Bracket_JP
        .Pattern = Ptn_Angle_JPN
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Angle_Bracket_EN
        .Pattern = Ptn_Angle_ENG
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Round_Bracket
        .Pattern = Ptn_RoundStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Round_Bracket_JP
        .Pattern = Ptn_Round_JPN
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Round_Bracket_EN
        .Pattern = Ptn_Round_ENG
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket
        .Pattern = Ptn_SquareStart
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket_JP
        .Pattern = Ptn_Square_JPN
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_SquareBracket_EN
        .Pattern = Ptn_Square_ENG
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Japanese
        .Pattern = Ptn_Japanese
        .IgnoreCase = True
        .Global = True
    End With
    With RegExp_Alphabet
        .Pattern = Ptn_Alphabet
        .IgnoreCase = False
        .Global = True
    End With
    With RegExp_JapaneseOnly
        .Pattern = Ptn_JapaneseOnly
        .IgnoreCase = True
        .Global = True
    End With
Set mySht1 = Worksheets("Sheet1")
Set mySht2 = Worksheets("Sheet2")
Set myRng = mySht1.UsedRange
tmpAr = myRng
Major_CategoryAr = MajorCategoryAr(mySht2)
ReDim Preserve Major_CategoryAr(UBound(Major_CategoryAr), UBound(Major_CategoryAr, 2) + 2)
m = 0
For i = LBound(tmpAr) To UBound(tmpAr)
    For n = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
        If Major_CategoryAr(n, 0) = tmpAr(i, 1) Then
            Major_CategoryAr(n, 11) = i
        End If
        If Major_CategoryAr(n, 1) = tmpAr(i, 1) Then
            Major_CategoryAr(n, 12) = i
        End If
    Next n
Next i
m = 0
n = 0
p = 0
q = 0
No_Cancel_Ar = NoCancelArray(mySht1)
For r = LBound(No_Cancel_Ar) To UBound(No_Cancel_Ar)
For i = No_Cancel_Ar(r, 0) To No_Cancel_Ar(r, 1)
        str_JPN_Analyse = ""
        str_ENG_Analyse = ""
        On Error Resume Next
        For k = 1 To 5
            str_JPN_Analyse = str_JPN_Analyse & tmpAr(i, k)
            str_ENG_Analyse = str_ENG_Analyse & " " & tmpAr(i + 1, k)
            str_ENG_Analyse = Replace(str_ENG_Analyse, "  ", " ")
        Next k
        For k = 1 To 3
            str_ENG_Analyse = str_ENG_Analyse & " " & tmpAr(i + 2, k)
            str_ENG_Analyse = Replace(str_ENG_Analyse, "  ", " ")
        Next k
        On Error GoTo 0
        str_ENG_Analyse = Trim(str_ENG_Analyse)
        Select Case True
        Case RegExp_Angle_Bracket.Test(str_JPN_Analyse) And _
             RegExp_Angle_Bracket.Test(str_ENG_Analyse)
            ReDim Preserve Sub_FoodGroup_JP(p)
            ReDim Preserve Sub_FoodGroup_EN(p)
            ReDim Preserve Sub_Group_JP_Row(p)
            ReDim Preserve Sub_Group_EN_Row(p)
            Set myMatches = RegExp_Angle_Bracket_JP.Execute(str_JPN_Analyse)
            Sub_FoodGroup_JP(p) = myMatches.Item(0).Value
            Sub_Group_JP_Row(p) = i
            Set myMatches = RegExp_Angle_Bracket_EN.Execute(str_ENG_Analyse)
            Sub_FoodGroup_EN(p) = myMatches.Item(0).Value
            Sub_FoodGroup_EN(p) = Replace(Sub_FoodGroup_EN(p), "<", "<")
            Sub_FoodGroup_EN(p) = Replace(Sub_FoodGroup_EN(p), ">", ">")
            Sub_Group_EN_Row(p) = i + 1
            p = p + 1
        Case RegExp_Round_Bracket_JP.Test(str_JPN_Analyse) And _
             RegExp_Round_Bracket_EN.Test(str_ENG_Analyse)
            ReDim Preserve Sub_Category_JPN(n)
            ReDim Preserve Sub_Category_ENG(n)
            ReDim Preserve SubCategory_RowJ(n)
            ReDim Preserve SubCategory_RowE(n)
            Set myMatches = RegExp_Round_Bracket_JP.Execute(str_JPN_Analyse)
            Sub_Category_JPN(n) = myMatches.Item(0).Value
            Sub_Category_JPN(n) = Replace(Sub_Category_JPN(n), "(", "(")
            Sub_Category_JPN(n) = Replace(Sub_Category_JPN(n), ")", ")")
            SubCategory_RowJ(n) = i
            Set myMatches = RegExp_Round_Bracket_EN.Execute(str_ENG_Analyse)
            Sub_Category_ENG(n) = myMatches.Item(0).Value
            Sub_Category_ENG(n) = Replace(Sub_Category_ENG(n), "(", "(")
            Sub_Category_ENG(n) = Replace(Sub_Category_ENG(n), ")", ")")
            SubCategory_RowE(n) = i + 1
            n = n + 1
        Case RegExp_SquareBracket_JP.Test(str_JPN_Analyse) And _
             RegExp_SquareBracket_EN.Test(str_ENG_Analyse)
            ReDim Preserve MediumCategoryJP(m)
            ReDim Preserve Med_JP_RowNumber(m)
            ReDim Preserve MediumCategoryEN(m)
            ReDim Preserve Med_EN_RowNumber(m)
            Set myMatches = RegExp_SquareBracket_JP.Execute(str_JPN_Analyse)
            MediumCategoryJP(m) = myMatches.Item(0).Value
            Med_JP_RowNumber(m) = i
            Set myMatches = RegExp_SquareBracket_EN.Execute(str_ENG_Analyse)
            MediumCategoryEN(m) = myMatches.Item(0).Value
            Med_EN_RowNumber(m) = i + 1
            m = m + 1
        Case RegExp_Japanese.Test(str_JPN_Analyse) And _
             RegExp_Alphabet.Test(str_ENG_Analyse)
            ReDim Preserve Major_CategoryJP(q)
            ReDim Preserve Major_CategoryEN(q)
            ReDim Preserve Major_JPN_RowNum(q)
            ReDim Preserve Major_ENG_RowNum(q)
            Set myMatches = RegExp_Japanese.Execute(str_JPN_Analyse)
            Major_CategoryJP(q) = myMatches.Item(0).Value
            Major_JPN_RowNum(q) = i
            Set myMatches = RegExp_Alphabet.Execute(str_ENG_Analyse)
            Major_CategoryEN(q) = myMatches.Item(0).Value
            Major_ENG_RowNum(q) = i + 1
            q = q + 1
        Case Else
        End Select
Next i
Next r
ReDim Major_Temp_Array(UBound(Major_CategoryJP), 5)
For q = LBound(Major_Temp_Array) To UBound(Major_Temp_Array) - 1
    Major_Temp_Array(q, 0) = Major_CategoryJP(q)
    Major_Temp_Array(q, 1) = Major_JPN_RowNum(q)
    Major_Temp_Array(q, 2) = Major_JPN_RowNum(q + 1)
    Major_Temp_Array(q, 3) = Major_CategoryEN(q)
    Major_Temp_Array(q, 4) = Major_ENG_RowNum(q)
    Major_Temp_Array(q, 5) = Major_ENG_RowNum(q + 1)
Next q
    Major_Temp_Array(q, 0) = Major_CategoryJP(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 1) = Major_JPN_RowNum(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 2) = 32757
    Major_Temp_Array(q, 3) = Major_CategoryEN(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 4) = Major_ENG_RowNum(UBound(Major_Temp_Array))
    Major_Temp_Array(q, 5) = 32757
ReDim MediumCategoryAr(UBound(MediumCategoryJP), 5)
For m = LBound(MediumCategoryAr) To UBound(MediumCategoryAr) - 1
    MediumCategoryAr(m, 0) = MediumCategoryJP(m)
    MediumCategoryAr(m, 1) = Med_JP_RowNumber(m)
    MediumCategoryAr(m, 2) = Med_JP_RowNumber(m + 1)
    MediumCategoryAr(m, 3) = MediumCategoryEN(m)
    MediumCategoryAr(m, 4) = Med_EN_RowNumber(m)
    MediumCategoryAr(m, 5) = Med_EN_RowNumber(m + 1)
Next m
    MediumCategoryAr(m, 0) = MediumCategoryJP(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 1) = Med_JP_RowNumber(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 2) = 26271
    MediumCategoryAr(m, 3) = MediumCategoryEN(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 4) = Med_EN_RowNumber(UBound(MediumCategoryAr))
    MediumCategoryAr(m, 5) = 26271
For m = LBound(MediumCategoryAr) To UBound(MediumCategoryAr)
    For n = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
        If CLng(MediumCategoryAr(m, 1)) > CLng(Major_CategoryAr(n, 11)) And _
           CLng(MediumCategoryAr(m, 1)) < CLng(Major_CategoryAr(n, 12)) And _
           CLng(Major_CategoryAr(n, 12)) < CLng(MediumCategoryAr(m, 2)) Then
            MediumCategoryAr(m, 2) = Major_CategoryAr(n, 12)
        End If
        If CLng(MediumCategoryAr(m, 4)) > CLng(Major_CategoryAr(n, 11)) And _
           CLng(MediumCategoryAr(m, 4)) < CLng(Major_CategoryAr(n, 12)) And _
           CLng(Major_CategoryAr(n, 12)) < CLng(MediumCategoryAr(m, 5)) Then
            MediumCategoryAr(m, 5) = Major_CategoryAr(n, 12)
            Exit For
        End If
    Next n
Next m
p = 0
For i = LBound(tmpAr) To UBound(tmpAr) - 1
    strMinor_CategoryJP = ""
    strMinor_CategoryEN = ""
    For n = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
        If RegExp_JapaneseOnly.Test(tmpAr(i, 1)) And _
       Not RegExp_5_Number.Test(tmpAr(i, 1)) And _
       Not RegExp_Round_Bracket.Test(tmpAr(i, 1)) And _
       Not RegExp_SquareBracket.Test(tmpAr(i, 1)) And _
       Not RegExp_Angle_Bracket.Test(tmpAr(i, 1)) And _
           InStr(tmpAr(i, 1), Major_CategoryAr(n, 8)) <> 0 And _
           InStr(tmpAr(i + 1, 1), Major_CategoryAr(n, 9)) <> 0 And _
           i >= Major_CategoryAr(n, 11) And _
           i <= Major_CategoryAr(n, 12) Then
            ReDim Preserve Minor_CategoryJP(p)
            ReDim Preserve Minor_CategoryEN(p)
            ReDim Preserve Min_JP_RowNumber(p)
            ReDim Preserve Min_EN_RowNumber(p)
            For k = 1 To 2
                strMinor_CategoryJP = strMinor_CategoryJP & tmpAr(i, k)
                strMinor_CategoryEN = strMinor_CategoryEN & " " & tmpAr(i + 1, k)
                strMinor_CategoryEN = Trim(strMinor_CategoryEN)
            Next k
            Set myMatches = RegExp_JapaneseOnly.Execute(strMinor_CategoryJP)
            Minor_CategoryJP(p) = strMinor_CategoryJP
            Min_JP_RowNumber(p) = i
            Set myMatches = RegExp_Upper_Lower.Execute(strMinor_CategoryEN)
            Minor_CategoryEN(p) = strMinor_CategoryEN
            Min_EN_RowNumber(p) = i + 1
            p = p + 1
        Else
        End If
    Next n
Next i
j = 0
For i = LBound(tmpAr) To UBound(tmpAr)
    strFoodGroup = ""
    strSubFoodGroup = ""
    strSub_Category = ""
    strMajor_Category = ""
    strMinor_Category = ""
    strDetailCategory = ""
    If RegExp_5_Number.Test(tmpAr(i, 1)) And tmpAr(i, 2) <> "(欠番)" Then
        ReDim Preserve ItemNamAr(j)
        ReDim Preserve ItemNumAr(j)
        ReDim Preserve FoodGrouNum(j)
        ReDim Preserve FoodGroupJP(j)
        ReDim Preserve FoodGroupEN(j)
        ReDim Preserve Sub_FoodGroup_JP(j)
        ReDim Preserve Sub_FoodGroup_EN(j)
        ReDim Preserve Sub_Category_JPN(j)
        ReDim Preserve Sub_Category_ENG(j)
        ReDim Preserve Major_CategoryJP(j)
        ReDim Preserve Major_CategoryEN(j)
        ReDim Preserve Major_CategoryLT(j)
        ReDim Preserve Med_Category_JPN(j)
        ReDim Preserve Med_Category_ENG(j)
        ReDim Preserve Minor_CategoryJP(j)
        ReDim Preserve Minor_CategoryEN(j)
        ReDim Preserve DetailCategoryJP(j)
        ReDim Preserve DetailCategoryEN(j)
        ReDim Preserve JapaneseName(j)
        ReDim Preserve English_Name(j)
        ItemNamAr(j) = tmpAr(i, 1)
        ItemNumAr(j) = i
        Select Case True
            Case Left(tmpAr(i, 1), 2) = "01"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "穀類"
                FoodGroupEN(j) = "CEREALS"
                CEREALS = CEREALS + 1
            Case Left(tmpAr(i, 1), 2) = "02"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "いも及びでん粉類"
                FoodGroupEN(j) = "POTATOES AND STARCHES"
                POTATOES = POTATOES + 1
            Case Left(tmpAr(i, 1), 2) = "03"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "砂糖及び甘味類"
                FoodGroupEN(j) = "SUGARS"
                SUGARS = SUGARS + 1
            Case Left(tmpAr(i, 1), 2) = "04"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "豆類"
                FoodGroupEN(j) = "PULSES"
                PULSES = PULSES + 1
            Case Left(tmpAr(i, 1), 2) = "05"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "種実類"
                FoodGroupEN(j) = "NUTS AND SEEDS"
                NUTS = NUTS + 1
            Case Left(tmpAr(i, 1), 2) = "06"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "野菜類"
                FoodGroupEN(j) = "VEGETABLES"
                VEGETABLES = VEGETABLES + 1
            Case Left(tmpAr(i, 1), 2) = "07"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "果実類"
                FoodGroupEN(j) = "FRUITS"
                FRUITS = FRUITS + 1
            Case Left(tmpAr(i, 1), 2) = "08"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "きのこ類"
                FoodGroupEN(j) = "MUSHROOMS"
                MUSHROOMS = MUSHROOMS + 1
            Case Left(tmpAr(i, 1), 2) = "09"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "藻類"
                FoodGroupEN(j) = "ALGAE"
                ALGAE = ALGAE + 1
            Case Left(tmpAr(i, 1), 2) = "10"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "魚介類"
                FoodGroupEN(j) = "FISHES AND SHELLFISHES"
                FISHES = FISHES + 1
            Case Left(tmpAr(i, 1), 2) = "11"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "肉類"
                FoodGroupEN(j) = "MEATS"
                MEATS = MEATS + 1
            Case Left(tmpAr(i, 1), 2) = "12"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "卵類"
                FoodGroupEN(j) = "EGGS"
                EGGS = EGGS + 1
            Case Left(tmpAr(i, 1), 2) = "13"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "乳類"
                FoodGroupEN(j) = "MILKS"
                MILK = MILK + 1
            Case Left(tmpAr(i, 1), 2) = "14"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "油脂類"
                FoodGroupEN(j) = "FATS AND OILS"
                OIL = OIL + 1
            Case Left(tmpAr(i, 1), 2) = "15"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "菓子類"
                FoodGroupEN(j) = "CONFECTIONERIES"
                CONFECTIONERIES = CONFECTIONERIES + 1
            Case Left(tmpAr(i, 1), 2) = "16"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "し好飲料類"
                FoodGroupEN(j) = "BEVERAGES"
                BEVERAGES = BEVERAGES + 1
            Case Left(tmpAr(i, 1), 2) = "17"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "調味料及び香辛料類"
                FoodGroupEN(j) = "SEASONINGS AND SPICES"
                SEASONINGS = SEASONINGS + 1
            Case Left(tmpAr(i, 1), 2) = "18"
                FoodGrouNum(j) = Left(tmpAr(i, 1), 2)
                FoodGroupJP(j) = "調理加工食品類"
                FoodGroupEN(j) = "PREPARED FOODS"
                PREPARED = PREPARED + 1
            Case Else
        End Select
        If RegExpJapaneseName.Test(tmpAr(i, 2)) Then
            Set myMatches = RegExpJapaneseName.Execute(tmpAr(i, 2))
            JapaneseName(j) = myMatches.Item(0).Value
        End If
        For t = 1 To 6
            If RegExp_EnglishName.Test(tmpAr(i + 1, t)) Then
                English_Name(j) = English_Name(j) & " " & tmpAr(i + 1, t)
                English_Name(j) = Trim(English_Name(j))
            Else
                Exit For
            End If
        Next t
        For k = LBound(Major_CategoryAr) To UBound(Major_CategoryAr)
            If CLng(tmpAr(i, 1)) >= CLng(Major_CategoryAr(k, 0)) _
           And CLng(tmpAr(i, 1)) <= CLng(Major_CategoryAr(k, 1)) Then
                Sub_FoodGroup_JP(j) = Major_CategoryAr(k, 4)
                Sub_FoodGroup_EN(j) = Major_CategoryAr(k, 5)
                Sub_Category_JPN(j) = Major_CategoryAr(k, 6)
                Sub_Category_ENG(j) = Major_CategoryAr(k, 7)
                Major_CategoryJP(j) = Major_CategoryAr(k, 8)
                Major_CategoryEN(j) = Major_CategoryAr(k, 9)
                Major_CategoryLT(j) = Major_CategoryAr(k, 10)
                For m = LBound(MediumCategoryAr) To UBound(MediumCategoryAr)
                    If i >= CLng(MediumCategoryAr(m, 1)) And _
                       i <= CLng(MediumCategoryAr(m, 2)) Then
                        Med_Category_JPN(j) = MediumCategoryAr(m, 0)
                    End If
                    If i >= CLng(MediumCategoryAr(m, 4)) And _
                       i <= CLng(MediumCategoryAr(m, 5)) Then
                        Med_Category_ENG(j) = MediumCategoryAr(m, 3)
                    End If
                Next m
            Else
            End If
        Next k
    Else
        j = j - 1
    End If
    j = j + 1
Next i
ReDim ItemArray(UBound(ItemNamAr), 14)
For i = LBound(ItemArray) To UBound(ItemArray)
    ItemArray(i, 0) = ItemNamAr(i)
    ItemArray(i, 1) = FoodGrouNum(i)
    ItemArray(i, 2) = FoodGroupJP(i)
    ItemArray(i, 3) = FoodGroupEN(i)
    ItemArray(i, 4) = Sub_FoodGroup_JP(i)
    ItemArray(i, 5) = Sub_FoodGroup_EN(i)
    ItemArray(i, 6) = Sub_Category_JPN(i)
    ItemArray(i, 7) = Sub_Category_ENG(i)
    ItemArray(i, 8) = Major_CategoryJP(i)
    ItemArray(i, 9) = Major_CategoryEN(i)
    ItemArray(i, 10) = Major_CategoryLT(i)
    ItemArray(i, 11) = Med_Category_JPN(i)
    ItemArray(i, 12) = Med_Category_ENG(i)
    ItemArray(i, 13) = JapaneseName(i)
    ItemArray(i, 14) = English_Name(i)
Next i
Set mySht3 = Worksheets.Add
With mySht3
    .Name = "Result"
    .Range("A1").Value = "ItemNumber"
    .Range("B1").Value = "食品群番号"
    .Range("C1").Value = "食品群"
    .Range("D1").Value = "FoodGroup"
    .Range("E1").Value = "副分類"
    .Range("F1").Value = "SubFoodGroup"
    .Range("G1").Value = "区分"
    .Range("H1").Value = "SubCategory"
    .Range("I1").Value = "大分類"
    .Range("J1").Value = "MajorCategory"
    .Range("K1").Value = "AcademicName"
    .Range("L1").Value = "中分類"
    .Range("M1").Value = "MediumCategory"
    .Range("N1").Value = "小分類・細分"
    .Range("O1").Value = "MinorCategory_Details"
    .Range("A2:O1879").Value = ItemArray
End With
End Sub

Function NoCancelArray(ByRef Sh As Worksheet) As Variant
Dim mySht           As Worksheet
Dim myRng           As Range
Dim tmpAr           As Variant
Dim i               As Long
Dim j               As Long
Dim RegExpCancel    As Object
Dim RegExp_Exit     As Object
Const StrCancel     As String = "^(1\)|residues)$"
Dim CancelItem()    As String
Dim CancelRow1()    As String
Dim CancelRow2()    As String
Dim myCancelAr()    As String
Dim Cancel_Array()  As String
Set RegExpCancel = CreateObject("VBScript.RegExp")
With RegExpCancel
    .Pattern = StrCancel
    .IgnoreCase = True
    .Global = True
End With
Set mySht = Sh
Set myRng = mySht.UsedRange
tmpAr = myRng
j = 0
For i = LBound(tmpAr) To UBound(tmpAr)
    If RegExpCancel.Test(tmpAr(i, 1)) Then
        ReDim Preserve CancelItem(j)
        ReDim Preserve CancelRow1(i)
        CancelItem(j) = tmpAr(i, 1)
        CancelRow1(j) = i
        j = j + 1
    End If
Next i
ReDim myCancelAr(UBound(CancelItem), 1)
For j = LBound(myCancelAr) To UBound(myCancelAr)
    myCancelAr(j, 0) = CancelItem(j)
    myCancelAr(j, 1) = CancelRow1(j)
Next j
ReDim Preserve myCancelAr(UBound(myCancelAr), 2)
j = 0
For i = LBound(myCancelAr) To UBound(myCancelAr) - 1
    If myCancelAr(i, 0) = "1)" Then
        If myCancelAr(i + 2, 0) = "residues" Then
            myCancelAr(i, 2) = myCancelAr(i + 2, 1)
        Else
            myCancelAr(i, 2) = myCancelAr(i + 1, 1)
        End If
        j = j + 1
    End If
Next i
Erase CancelRow1
j = 0
ReDim CancelRow1(j)
ReDim CancelRow2(j)
CancelRow1(j) = myCancelAr(j, 1)
CancelRow2(j) = myCancelAr(j, 2)
For i = LBound(myCancelAr) + 1 To UBound(myCancelAr)
    If myCancelAr(i, 0) = "1)" And _
       myCancelAr(i - 1, 0) <> "1)" Then
        j = j + 1
        ReDim Preserve CancelRow1(j)
        ReDim Preserve CancelRow2(j)
        CancelRow1(j) = myCancelAr(i, 1)
        CancelRow2(j) = myCancelAr(i, 2)
    End If
Next i
ReDim Cancel_Array(UBound(CancelRow1), 1)
j = 0
For j = LBound(Cancel_Array) To UBound(Cancel_Array)
    Cancel_Array(j, 0) = CancelRow1(j)
    Cancel_Array(j, 1) = CancelRow2(j)
Next j
j = 0
Cancel_Array(j, 0) = 1
Cancel_Array(j, 1) = CancelRow1(j)
For j = LBound(Cancel_Array) + 1 To UBound(Cancel_Array)
    Cancel_Array(j, 0) = CancelRow2(j - 1)
    Cancel_Array(j, 1) = CancelRow1(j)
Next j
NoCancelArray = Cancel_Array
End Function

参照:
日本食品標準成分表2010のcsvファイル
日本食品標準成分表2010の食品番号をカテゴリー分類する その2