アラビア数字を漢数字に変換する

 投稿者：山中和義  投稿日：2009年11月 7日(土)20時08分30秒
  
!アラビア数字（1,2,3,…）を漢数字（一,二,三,…）に変換する（Excel準拠）

LET n1$="〇一二三四五六七八九" !漢数字
LET f1$="千百十　" !位
LET f2$="垓京兆億万　" !４桁ずつの位

LET n2$="〇壱弐参四伍六七八九" !大字
LET f3$="阡百拾　" !位
LET f4$="垓京兆億萬　" !４桁ずつの位

LET n3$="０１２３４５６７８９" !数字

FUNCTION NumberString$(x,p) !アラビア数字（1,2,3,…）を漢数字（一,二,三,…）に変換する
   IF x<0 OR x<>INT(x) THEN
      PRINT "非負の整数ではありません。"; x
      STOP
   ELSE
      LET w$=""

      SELECT CASE p
      CASE 1 !漢数字で表記する
         LET a=x
         IF a=0 THEN
            LET w$="〇"
         ELSE
            LET i=LEN(f2$)
            DO UNTIL a=0 !上位の数字がなくなるまで
               LET aa=MOD(a,10000) !「…兆億万　」の４桁ずつ
               IF aa<>0 THEN
                  LET ww$=f2$(i:i)
                  IF ww$<>"　" THEN LET w$=ww$&w$

                  LET k=LEN(f1$)
                  DO UNTIL aa=0 !各「千百十　」の位
                     LET ww$=f1$(k:k)
                     IF ww$="　" THEN LET ww$=""

                     LET t=MOD(aa,10) !一の位から
                     IF t=0 THEN !ゼロ・サプレス
                     ELSEIF k<LEN(f1$) AND t=1 THEN !１・サプレス
                        LET w$=ww$&w$
                     ELSE
                        LET w$=n1$(t+1:t+1)&ww$&w$
                     END IF

                     LET aa=INT(aa/10) !次へ
                     LET k=k-1
                  LOOP
               END IF

               LET a=INT(a/10000) !次へ
               LET i=i-1
            LOOP
         END IF

      CASE 2 !大字の漢数字で表記する
         LET a=x
         IF a=0 THEN
            LET w$="〇"
         ELSE
            LET i=LEN(f4$)
            DO UNTIL a=0 !上位の数字がなくなるまで
               LET aa=MOD(a,10000) !「…兆億万　」の４桁ずつ
               IF aa<>0 THEN
                  LET ww$=f4$(i:i)
                  IF ww$<>"　" THEN LET w$=ww$&w$

                  LET k=LEN(f3$)
                  DO UNTIL aa=0 !各「千百十　」の位
                     LET ww$=f3$(k:k)
                     IF ww$="　" THEN LET ww$=""

                     LET t=MOD(aa,10) !一の位から
                     IF t=0 THEN !ゼロ・サプレス
                     !!!ELSEIF k<LEN(f3$) AND t=1 THEN !１・サプレス
                     !!!   LET w$=ww$&w$
                     ELSE
                        LET w$=n2$(t+1:t+1)&ww$&w$
                     END IF

                     LET aa=INT(aa/10) !次へ
                     LET k=k-1
                  LOOP
               END IF

               LET a=INT(a/10000) !次へ
               LET i=i-1
            LOOP
         END IF

      CASE 3 !数値をそのまま漢数字で表記する
         LET a=x
         IF a=0 THEN
            LET w$="０"
         ELSE
            DO UNTIL a=0 !上位の桁がなくなるまで
               LET t=MOD(a,10)+1 !一の位から
               LET w$=n1$(t:t)&w$
               LET a=INT(a/10) !次へ
            LOOP
         END IF

      CASE 4 !十,百,千,万などを漢数字で表記する
         LET a=x
         IF a=0 THEN
            LET w$="〇"
         ELSE
            LET i=LEN(f2$)
            DO UNTIL a=0 !上位の数字がなくなるまで
               LET aa=MOD(a,10000) !「…兆億万　」の４桁ずつ
               IF aa<>0 THEN
                  LET ww$=f2$(i:i)
                  IF ww$<>"　" THEN LET w$=ww$&w$

                  LET k=LEN(f1$)
                  DO UNTIL aa=0 !各「千百十　」の位
                     LET ww$=f1$(k:k)
                     IF ww$="　" THEN LET ww$=""

                     LET t=MOD(aa,10) !一の位から
                     IF t=0 THEN !ゼロ・サプレス
                     ELSEIF k<LEN(f1$) AND t=1 THEN !１・サプレス
                        LET w$=ww$&w$
                     ELSE
                        LET w$=n3$(t+1:t+1)&ww$&w$
                     END IF

                     LET aa=INT(aa/10) !次へ
                     LET k=k-1
                  LOOP
               END IF

               LET a=INT(a/10000) !次へ
               LET i=i-1
            LOOP
         END IF

      CASE ELSE
      END SELECT

      LET NumberString$=w$ !結果を返す
   END IF
END FUNCTION


!!!PRINT NumberString$(1732050807568877,2) !※1000桁モード、有理数モード

PRINT NumberString$(1234567890,1) !十二億三千四百五十六万七千八百九十
PRINT NumberString$(1234567890,2) !壱拾弐億参阡四百伍拾六萬七阡八百九拾
PRINT NumberString$(1234567890,3) !一二三四五六七八九〇
PRINT NumberString$(1234567890,4) !十２億３千４百５十６万７千８百９十

END
 

Re: アラビア数字を漢数字に変換する

 投稿者：荒田浩二  投稿日：2009年11月14日(土)13時43分40秒
  > No.713[元記事へ]

漢数字に変換する関数を拡張させていただきました。
p=5 として、１２億３４５６万７８００という形式を付加しました。
また、小数の漢数字変換もできるようにしました。

!アラビア数字（1,2,3,…）を漢数字（一,二,三,…）に変換する NumberString2$(x,p)（Excel準拠ではない）
!アラビア数字小数部（.123…）を漢数字（一分二厘三毛…）に変換する NumberString3$(x,p)（独立して利用可）

LET n1$="〇一二三四五六七八九" !漢数字
LET f1$="千百十　" !位
LET f2$="垓京兆億万　" !４桁ずつの位

LET n2$="〇壱弐参四伍六七八九" !大字
LET f3$="阡百拾　" !位
LET f4$="垓京兆億萬　" !４桁ずつの位

LET n3$="０１２３４５６７８９" !数字

DIM ff$(25)
FOR i=1 TO 25
   READ IF MISSING THEN EXIT FOR : ff$(i)
NEXT i
!DATA 割,分,厘,毛,糸,忽,微,繊,沙,塵,埃,渺,漠,模糊,逡巡,須臾,瞬息,弾指,刹那,六徳,虚空,清浄,阿頼耶,阿摩羅,涅槃寂静 !割合表記
DATA 分,厘,毛,糸,忽,微,繊,沙,塵,埃,渺,漠,模糊,逡巡,須臾,瞬息,弾指,刹那,六徳,虚空,清浄,阿頼耶,阿摩羅,涅槃寂静 !本来表記
!"埃"以降は諸説あり

FUNCTION NumberString2$(x,p) !アラビア数字（1,2,3,…）を漢数字（一,二,三,…）に変換する
   IF x<0 THEN
      PRINT "非負ではありません。"; x
      STOP
   ELSE
      LET w$=""

      SELECT CASE p
      CASE 1 !漢数字で表記する
         LET a=INT(x) !!
         IF a=0 THEN
            LET w$="〇"
         ELSE
            LET i=LEN(f2$)
            DO UNTIL a=0 !上位の数字がなくなるまで
               LET aa=MOD(a,10000) !「…兆億万　」の４桁ずつ
               IF aa<>0 THEN
                  LET ww$=f2$(i:i)
                  IF ww$<>"　" THEN LET w$=ww$&w$

                  LET k=LEN(f1$)
                  DO UNTIL aa=0 !各「千百十　」の位
                     LET ww$=f1$(k:k)
                     IF ww$="　" THEN LET ww$=""

                     LET t=MOD(aa,10) !一の位から
                     IF t=0 THEN !ゼロ・サプレス
                     ELSEIF k<LEN(f1$) AND t=1 THEN !１・サプレス
                        LET w$=ww$&w$
                     ELSE
                        LET w$=n1$(t+1:t+1)&ww$&w$
                     END IF

                     LET aa=INT(aa/10) !次へ
                     LET k=k-1
                  LOOP
               END IF

               LET a=INT(a/10000) !次へ
               LET i=i-1
            LOOP
         END IF

      CASE 2 !大字の漢数字で表記する
         LET a=INT(x) !!
         IF a=0 THEN
            LET w$="〇"
         ELSE
            LET i=LEN(f4$)
            DO UNTIL a=0 !上位の数字がなくなるまで
               LET aa=MOD(a,10000) !「…兆億万　」の４桁ずつ
               IF aa<>0 THEN
                  LET ww$=f4$(i:i)
                  IF ww$<>"　" THEN LET w$=ww$&w$

                  LET k=LEN(f3$)
                  DO UNTIL aa=0 !各「千百十　」の位
                     LET ww$=f3$(k:k)
                     IF ww$="　" THEN LET ww$=""

                     LET t=MOD(aa,10) !一の位から
                     IF t=0 THEN !ゼロ・サプレス
                     !!!ELSEIF k<LEN(f3$) AND t=1 THEN !１・サプレス
                     !!!   LET w$=ww$&w$
                     ELSE
                        LET w$=n2$(t+1:t+1)&ww$&w$
                     END IF

                     LET aa=INT(aa/10) !次へ
                     LET k=k-1
                  LOOP
               END IF

               LET a=INT(a/10000) !次へ
               LET i=i-1
            LOOP
         END IF

      CASE 3 !数値をそのまま漢数字で表記する
         LET a=INT(x) !!
         IF a=0 THEN
            LET w$="〇" !!
         ELSE
            DO UNTIL a=0 !上位の桁がなくなるまで
               LET t=MOD(a,10)+1 !一の位から
               LET w$=n1$(t:t)&w$
               LET a=INT(a/10) !次へ
            LOOP
         END IF

      CASE 4 !十,百,千,万などを漢数字で表記する
         LET a=INT(x) !!
         IF a=0 THEN
            LET w$="０" !!
         ELSE
            LET i=LEN(f2$)
            DO UNTIL a=0 !上位の数字がなくなるまで
               LET aa=MOD(a,10000) !「…兆億万　」の４桁ずつ
               IF aa<>0 THEN
                  LET ww$=f2$(i:i)
                  IF ww$<>"　" THEN LET w$=ww$&w$

                  LET k=LEN(f1$)
                  DO UNTIL aa=0 !各「千百十　」の位
                     LET ww$=f1$(k:k)
                     IF ww$="　" THEN LET ww$=""

                     LET t=MOD(aa,10) !一の位から
                     IF t=0 THEN !ゼロ・サプレス
                     ELSEIF k<LEN(f1$) AND t=1 THEN !１・サプレス
                        LET w$=ww$&w$
                     ELSE
                        LET w$=n3$(t+1:t+1)&ww$&w$
                     END IF

                     LET aa=INT(aa/10) !次へ
                     LET k=k-1
                  LOOP
               END IF

               LET a=INT(a/10000) !次へ
               LET i=i-1
            LOOP
         END IF

      CASE 5 !! 兆,億,万などを漢数字で表記する
         LET a=INT(x)
         IF a=0 THEN
            LET w$="０"&w$
         ELSE
            LET i=LEN(f2$)
            DO UNTIL a=0 !上位の数字がなくなるまで
               LET aa=MOD(a,10000) !「…兆億万　」の４桁ずつ
               IF aa<>0 THEN
                  LET ww$=f2$(i:i)
                  IF ww$<>"　" THEN LET w$=ww$&w$
                  DO UNTIL aa=0 !各「千百十　」の位
                     LET t=MOD(aa,10) !一の位から
                     LET w$=n3$(t+1:t+1)&w$
                     LET aa=INT(aa/10) !次へ
                  LOOP
               END IF
               LET a=INT(a/10000) !次へ
               LET i=i-1
            LOOP
         END IF !!

      CASE ELSE
      END SELECT

      IF x<>INT(x) THEN !!
         IF INT(x)=0 THEN
            LET w$=""
         ELSEIF p=1 OR p=2 OR p=4 THEN
            LET w$=w$&"・"
         END IF
         LET w$=w$&NumberString3$(FP(x),p) ! 小数部変換
      END IF !!

      LET NumberString2$=w$ !結果を返す
   END IF
END FUNCTION
!続く 		 

Re: アラビア数字を漢数字に変換する

 投稿者：荒田浩二  投稿日：2009年11月14日(土)13時45分21秒
  > No.713[元記事へ]

!続き
FUNCTION NumberString3$(x,p) !アラビア数字小数部（.123…）を漢数字（一分二厘三毛…）に変換する
   IF x<=0 OR x>=1 THEN
      PRINT "正の小数(0<x<1)ではありません。"; x
      STOP
   END IF
   LET b=x
   LET ww$=""
   LET k=1
   SELECT CASE p
   CASE 1 !漢数字で表記する(一分二厘三毛)
      DO UNTIL b=0 !小数がなくなるまで
         LET t=INT(10*b)
         WHEN EXCEPTION IN
            LET ff2$=ff$(k) ! 配列添字オーバーで例外発生
            IF t<>0 THEN LET ww$=ww$&n1$(t+1:t+1)&ff2$
         USE
            LET ww$=ww$&n1$(t+1:t+1) ! t=0を表記
         END WHEN
         LET b=10*b-t !次へ
         LET k=k+1
      LOOP
   CASE 2 !大字の漢数字で表記する(壱分弐厘参毛)
      DO UNTIL b=0 !小数がなくなるまで
         LET t=INT(10*b)
         WHEN EXCEPTION IN
            LET ff2$=ff$(k)
            IF t<>0 THEN LET ww$=ww$&n2$(t+1:t+1)&ff$(k)
         USE
            LET ww$=ww$&n2$(t+1:t+1)
         END WHEN
         LET b=10*b-t !次へ
         LET k=k+1
      LOOP
   CASE 3 !数値をそのまま漢数字で表記する(・一二三)
      LET ww$="・" ! 中黒
      DO UNTIL b=0 !小数がなくなるまで
         LET t=INT(10*b)
         LET ww$=ww$&n1$(t+1:t+1)
         LET b=10*b-t !次へ
      LOOP
   CASE 4 !分,厘,毛,糸などを漢数字で表記する(１分２厘３毛)
      DO UNTIL b=0 !小数がなくなるまで
         LET t=INT(10*b)
         WHEN EXCEPTION IN
            LET ff2$=ff$(k)
            IF t<>0 THEN LET ww$=ww$&n3$(t+1:t+1)&ff$(k)
         USE
            LET ww$=ww$&n3$(t+1:t+1)
         END WHEN
         LET b=10*b-t !次へ
         LET k=k+1
      LOOP
   CASE 5 !全角数字で表記する(．１２３)
      LET ww$="．" ! 全角ピリオド
      DO UNTIL b=0 !小数がなくなるまで
         LET t=INT(10*b)
         LET ww$=ww$&n3$(t+1:t+1)
         LET b=10*b-t !次へ
      LOOP
   CASE ELSE
   END SELECT
   LET NumberString3$=ww$ !結果を返す
END FUNCTION

!!!PRINT NumberString2$(1732050807568877,2) !※1000桁モード、有理数モード

PRINT NumberString2$(1234567890.1204,1) !十二億三千四百五十六万七千八百九十・一分二厘四糸
PRINT NumberString2$(1234567890.1204,2) !壱拾弐億参阡四百伍拾六)萬七阡八百九拾・壱分弐厘四糸
PRINT NumberString2$(1234567890.1204,3) !一二三四五六七八九〇・一二〇四
PRINT NumberString2$(1234567890.1204,4) !十２億３千４百５十６万７千８百９十・１分２厘４糸
PRINT NumberString2$(1234567890.1204,5) !１２億３４５６万７８９０．１２０４
PRINT
DIM x(4)
FOR p=1 TO 5
   PRINT NumberString2$(PI,p)
NEXT p
PRINT
LET x(1)=5000021007
LET x(2)=.023006
LET x(3)=48130000000
LET x(4)=7.31650080029041875E23 !※1000桁モード、有理数モード
FOR p=1 TO 5
   FOR ii=1 TO 4
      PRINT NumberString2$(x(ii),p),
   NEXT ii
   PRINT
NEXT p
END 		 

戻る