10 '====================================================================== 20 ' 渡辺 真 60 ' E-mail: makoto_watanabe@lime.livedoor.com 70 '======================================================================= 100 MAX=5000: N=1 110 CLS 3 120 PRINT "*** 部品表親品番を指定して構成品番を抽出する ***" 130 Dim PS$(MAX,4),PARENT$(MAX,1) 140 '******************************** 150 'ファイルの読み込み。Iは部品表標準リストの行数。 160 Open "C:\temp\bom0001_2.txt" For Input As #1 170 I=I+1 180 IF I=MAX+1 THEN Close #1:PRINT "部品表標準リスト件数オーバー。MAXの数字を大きくしてください。" :END 190 LINE INPUT #1,PRODST$ 200 PS$(I,1)=MID$(PRODST$,29,12):PS$(I,2)=MID$(PRODST$,43,4):PS$(I,3)=MID$(PRODST$,47,12):PS$(I,4)=MID$(PRODST$,65,4) 210 'GOTO 780 'DEBUG 220 IF EOF(1) THEN GOTO 240 230 GOTO 170 240 Close #1 :IF I=1 THEN PRINT "部品表標準ファイルがC:\temp\に登録されていません。" :END 250 '********************************** 260 '親品番の入力。Lは親品番の出現順位。Jは無意味なカウンタ。 270 PRINT "10 or 12桁の親品番を入力下さい。例:ZMT1WWWM4Wとか,XZMW1MZM9Zとか" 280 INPUT PARENT$(1,1) 290 PRINT "入力した親品番は";PARENT$(1,1) 294 PRINT "部品表標準リストを検索する間、しばらくお待ちください。" :PRINT 298 IF LEN(PARENT$(1,1))=10 THEN PARENT$(1,1)=PARENT$(1,1)+" " 300 FOR J=1 TO I 310 IF PARENT$(1,1)=PS$(J,1) THEN L=1 :GOTO 360 320 NEXT J 330 PRINT "この品番は部品表標準リストの親品番に有りません。正しい親品番を入力下さい。" 340 GOTO 260 350 L=1 360 GOSUB *CHILD 370 FOR L=1 TO N 380 IF PARENT$(L,0)="" THEN GOSUB *CHILD 390 NEXT L 400 GOTO 590 410 '************************************** 420 *CHILD '子品番を持つ構成の取得。Jは無意味なカウンタ。 430 FOR J=1 TO I 440 IF PS$(J,1)=PARENT$(L,1) THEN PS$(J,0)="1": CHILDREN$=PS$(J,3) :GOSUB *PARENTS 450 'PRINT J;PS$(J,1),PARENT$(L,1) 460 'PS$(J,0)=1は対象の構成情報の印。 470 NEXT J 480 PARENT$(L,0)="1" '子品番探しが終わった印。 490 RETURN 500 '************************************** 510 *PARENTS '親品番の登録。Nは登録した親品番の数。Kは無意味なカウンタ。 520 'Print PS$(J,0);PS$(J,1);PS$(J,2);PS$(J,3);PS$(J,4) 530 FOR K=1 TO N 540 IF PARENT$(K,1)=CHILDREN$ THEN RETURN 550 NEXT K 560 N=N+1 570 PARENT$(N,1)=CHILDREN$ 580 RETURN 590 '**************************************** 600 'ファイルの書き込み。Jは無意味なカウンタ。 610 Open "C:\temp\Prod_St.txt" For Output As #1 620 PRINT PARENT$(1,1);"を親とする構成は、以下です。" :PRINT 630 Print #1 ,PARENT$(1,1);"を親とする構成は、以下です。" 640 PRINT "Parent pref. Child Quantity" 650 Print #1 ,"Parent pref. Child Quantity" 660 FOR J=1 to I 670 IF PS$(J,0)="1" THEN Print PS$(J,1);PS$(J,2);PS$(J,3);PS$(J,4):Print #1 ,PS$(J,1);PS$(J,2);PS$(J,3);PS$(J,4):GOSUB *DELAY 680 NEXT J 690 Close #1 700 END 710 '******************************* 720 *DELAY 'Kは無意味なカウンタ。 730 FOR K=1 TO 1000 740 X=(LOG(7^100)^100) 750 NEXT K 760 RETURN 770 '******************************** 780 'DEBUG 790 Print PS$(1,1);PS$(1,2);PS$(1,3);PS$(1,4):END