teacup. [ 掲示板 ] [ 掲示板作成 ] [ 有料掲示板 ] [ ブログ ]

 投稿者
  題名
  内容 入力補助 youtubeの<IFRAME>タグが利用可能です。(詳細)
    
 URL
[ ケータイで使う ] [ BBSティッカー ] [ 書込み通知 ]


むり~

 投稿者:将美  投稿日:2012年 8月 7日(火)19時08分49秒
  何回送信しても返って来ます;;  
 

遅くなりました><

 投稿者:けんいち  投稿日:2012年 7月17日(火)20時38分43秒
  ああああ、、、
迷惑メールがたくさんくるんでほとんどの
ドメインを拒否してるのを忘れてました><

先程将美さんのアドレスを指定受信に設定しておきましたので
もう大丈夫だと思います。
 

(無題)

 投稿者:将美  投稿日:2012年 7月 6日(金)19時12分18秒
  PCから携帯にメールできなかったよ;;
 

は~い^^ノ

 投稿者:将美  投稿日:2012年 7月 3日(火)23時07分50秒
  無理しないでね。  

(無題)

 投稿者:けんいち  投稿日:2012年 7月 3日(火)22時20分11秒
  すいません、残業が長引いてもしかするとINできないかもしれません><

帰り次第けんいちでラピス1鯖にINしますが24時回りそうです…。
 

はいは~い^^

 投稿者:将美  投稿日:2012年 7月 3日(火)00時38分52秒
  では3日の23:30ころINしますね^^  

完了しました

 投稿者:けんいち  投稿日:2012年 7月 2日(月)23時24分9秒
  メイン垢だけ凍結解除できました!
サブ垢はもう復旧できそうになしです…OTZ

早速ログインしたんですが街は変わり果ててるわ。
人が少ないわ。
ギルドは消滅してるわ。
でうらしま状態でした(´・ω・`)

明日もこの時間ならログインできそうですが
そちらはどうですか?
 

らじゃー

 投稿者:将美  投稿日:2012年 7月 2日(月)01時27分15秒
  無事、解除できたら連絡よろしくです^^ノ  

(無題)

 投稿者:けんいち  投稿日:2012年 7月 2日(月)00時19分57秒
  遅くなりました(~ヘ~;)
どうもお久しぶりですキラキラ

ちょっと前にプレーしようとDLしたところ私のアカウント2つとも凍結されてました(´;ω;`)

明日に解除してもらうように申請しておきます!
 

足跡

 投稿者:将美  投稿日:2012年 6月24日(日)16時55分12秒
  ぺたぺたぺた。  

足跡

 投稿者:将美  投稿日:2012年 6月21日(木)23時38分57秒
  ぺたぺた  

時間が合えば

 投稿者:将美  投稿日:2012年 6月21日(木)00時35分36秒
  クロノスにINすることも可能です^^  

みてるよ~^^

 投稿者:将美  投稿日:2012年 6月20日(水)11時09分19秒
  巡回してます^^
お久しぶりです~。
 

まだ誰か見てるかな?

 投稿者:けんいち  投稿日:2012年 6月 6日(水)21時55分30秒
  すいません、らいおんさんの書き込みには気づいてましたが
その後の書き込みは今になって気づきました><

どうもお久しぶりです(`・ω・´)ノ
 

巡回中~

 投稿者:将美  投稿日:2012年 4月 7日(土)00時35分1秒
  異常なし(汗
 

今日も書き込み

 投稿者:将美  投稿日:2012年 4月 2日(月)23時21分7秒
  いませんね~^^;  

今日も書き込みその2

 投稿者:将美  投稿日:2012年 3月21日(水)23時51分23秒
  1年近く書き込みがないから
見つかるのも時間かかるね~^^;
 

今日も書き込み

 投稿者:将美  投稿日:2012年 3月18日(日)12時44分0秒
  いないなぁ・・・。  

追加です

 投稿者:将美  投稿日:2012年 3月18日(日)01時05分33秒
  今でもネトゲはやってるからね(汗)
 

生きてます(笑)

 投稿者:将美  投稿日:2012年 3月18日(日)01時03分25秒
  久しぶりのINです。
クロノスはちゃんとアップデートしてるよ
知り合いが誰もいないからすぐに落ちるけどね^^;
また時々、見にきますね。
またみんなに会えたらうれしいな^^
 

久しぶりに

 投稿者:燕将  投稿日:2011年 9月 7日(水)08時19分50秒
  久しぶりにクロノスやると今は様変わり
細々と他の人もインしてますよ
 

なんとなく・・・

 投稿者:らいおん  投稿日:2011年 3月29日(火)21時32分18秒
  ご無沙汰してます
なんとなくブラウザを普段使用しているIEからFIREFOX4に乗り換えようとDLをし、ふとブックマークを見てみたらここのページが残っていました。
懐かしく思い覗いてみたら、以前のままでした、もう誰も見ることもなく、そして書き込む事もないんだろうなぁ~と思いつつ、書き込みをしております
みんな元気にしてるのかな?みんなと遊べた時間すごく楽しかったです『ありがとう』またみんなで、わいわい遊べたら最高でしょうねぇ
それではまた逢えることを願いつつ、Good Bye
 

これなら

 投稿者:(・ω・`)  投稿日:2008年12月19日(金)23時55分25秒
  Const KETA = 20                 '桁数
Const n = (KETA - 1) \ 2 + 1    '配列サイズ
Const ics = 2
Sub macro_long_mul(a() As Variant, b() As Variant, c() As Variant)
   Dim cy As Long, i As Integer
   Dim ch As Long
   Dim j As Integer
   Dim k As Integer
   Dim l As Integer

   cy = 0    'ロング数*ショート数
   ch = 0
   For i = n To 0 Step -1
       If i > 4 Then
       j = i - 5
       For k = 5 To i - 5 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       Else
       j = 1
       For k = i - 1 To 0 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       End If
       c(i) = (ch + cy) Mod 10000
       cy = (ch + cy) \ 10000 'キャリー
       ch = 0
   Next i
End Sub
Sub macro_long_div(a() As Variant, c() As Variant, d() As Variant, e() As Variant)
    Dim i As Integer, j As Integer, k As Integer
    Dim o As Integer, p As Integer, q As Integer, s As Integer, t As Integer
    For q = 0 To n
        d(q) = c(q)
    Next q

   'a()の数字が格納されている桁を求める
    i = 0
    Do Until a(i) > 0
    i = i + 1
    Loop

   'd()の数字が格納されている桁を求める
    o = 0
    Do Until d(o) > 0
    o = o + 1
    Loop

    k = o
    s = 0
    e(s) = 0
    s = s + 1

    'd()の添え字がa()の添え字と同じになるまで繰り返し割る
    Do Until k = n
        If d(k) < a(i) Then
            If k = n Then
                d(k) = d(k) + d(k - 1) * 10000
            Else
                d(k + 1) = d(k + 1) + d(k) * 10000
                d(k) = 0
                k = k + 1
            End If
        End If
        If d(k) >= a(i) Then
            p = d(k) \ a(i)

            For q = i To 5
                If d(k) < p * a(q) Then     'p倍のa(q)の方が大きいときは一つ上の桁から引く
                    If d(k - 1) < (p * a(q)) \ 10000 Then   'p倍のa(q)の方がさらに大きいときはさらに一つ上の桁から引く
                        d(k - 1) = d(k - 1) + 10000
                        d(k - 2) = d(k - 2) - 1
                    End If

                    d(k - 1) = d(k - 1) - (p * a(q)) \ 10000    'そんなに大きくないが10000より大き時の処理

                    If d(k) < (p * a(q)) Mod 10000 Then '10000の除算よりd(k)が小さいときの処理
                        d(k) = d(k) + d(k - 1) * 10000
                        d(k - 1) = 0
                    End If
                    d(k) = d(k) - ((p * a(q)) Mod 10000)
                Else
                    d(k) = d(k) - p * a(q)  'なんでもない時はp倍したa(q)を引く
                End If
                If d(k) < p * a(q + 1) Then 'd(k)の桁が次のp倍したa(q)より小さい時だけkを進める
                    If k = n Then
                        Exit Do
                    Else
                        k = k + 1
                    End If
                End If
            Next q
        End If

                e(s) = p    '商を格納
                s = s + 1


        If d(k) > 10000 Then  'd(k)が10000より大きいときは一つ上の桁に数値を戻す(オーバーフロー対策
            d(k - 1) = d(k) \ 10000
            d(k) = d(k) Mod 10000
        End If

                t = k
                k = o

        If k < n Then
        Do Until d(k) > 1   'd()の先頭の桁の添え字を求める
            If k = n Then
                For q = t + 1 To n
                    e(s) = 0
                    s = s + 1
                Next q
                Exit Do
            End If
            k = k + 1
        Loop
        End If
        If s = n Then
            Exit Do
        End If


    Loop

    'e()の整形
    q = 0
    Do Until q = n
        If (e(q) \ 10000) > 0 Then
            cy = e(q) \ 10000
            e(q) = e(q) - cy * 10000
            e(q - 1) = e(q - 1) + cy
        End If
        q = q + 1
    Loop

    q = 0

    Do Until q = n
        If (d(q) \ 10000) > 0 Then
            cy = d(q) \ 10000
            d(q) = d(q) - cy * 10000
            d(q - 1) = d(q - 1) + cy
        End If
        q = q + 1
    Loop

End Sub

Sub disp(c() As Variant, ir As Variant)   'ロング数の表示
   Dim i As Integer
   For i = 0 To n
       Cells(ir, ics + i).Value = c(i)
       Cells(ir, ics + i).NumberFormatLocal = "0000"
   Next i
End Sub
Sub disp_h(num As Integer, ir As Integer)   'ロング数の表示
   Dim i As Integer
   Dim ch As String
   ch = "b"
   If num = 1 Then
   ch = "a"
   End If
   For i = 0 To 5
       Cells(ir, ics + i).Value = ch & "(" & Str(i) & ")"
   Next i
End Sub
Sub multi_div()
    Dim a(n) As Variant
    Dim b(n) As Variant, c(n) As Variant, d(n) As Variant, e(n) As Variant, f(n) As Variant
    Dim i As Integer, ir As Integer, num As Integer

    'a()とb()の読み込み
    a(0) = Sheets("sheet1").Range("b2").Value
    a(1) = Sheets("sheet1").Range("c2").Value
    a(2) = Sheets("sheet1").Range("d2").Value
    a(3) = Sheets("sheet1").Range("e2").Value
    a(4) = Sheets("sheet1").Range("f2").Value
    a(5) = Sheets("sheet1").Range("g2").Value

    b(0) = Sheets("sheet1").Range("b4").Value
    b(1) = Sheets("sheet1").Range("c4").Value
    b(2) = Sheets("sheet1").Range("d4").Value
    b(3) = Sheets("sheet1").Range("e4").Value
    b(4) = Sheets("sheet1").Range("f4").Value
    b(5) = Sheets("sheet1").Range("g4").Value

   ir = 2 'irは何行目から表示するか?

   'a()のNL向けf()配列
    For i = 0 To n
        If i < 5 Then
            f(i) = 0
        Else
            f(i) = a(i - 5)
        End If
    Next i


'-----------
   disp_h 1, 1
   Cells(ir, 1).Value = "a()=" 'irの1個下の行からa()を表示
   disp a(), ir                'dispはa()の計算式を表示させるコマンド,の後ろは上で指定した行に計算させるという意味
'-----------
   ir = ir + 2
   disp_h 2, 3
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 2
   Cells(ir, 1).Value = "a()="
   disp a(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "a()*b()="
   macro_long_mul a(), b(), c()
   disp c(), ir
'-----------
   ir = ir + 2
   disp f(), ir
   Cells(ir, 1).Value = "a()*b()/b()="
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "shou()="
   macro_long_div a(), c(), d(), e()
   disp e(), ir
   disp d(), ir + 1
   Cells(ir + 1, 1).Value = "amari()="
'-----------
End Sub
 

test

 投稿者:けんいち  投稿日:2008年12月19日(金)22時31分3秒
  Const KETA = 20                 '桁数
Const n = (KETA - 1) \ 2 + 1    '配列サイズ
Const ics = 2
Sub macro_long_mul(a() As Variant, b() As Variant, c() As Variant)
   Dim cy As Long, i As Integer
   Dim ch As Long
   Dim j As Integer
   Dim k As Integer
   Dim l As Integer

   cy = 0    'ロング数*ショート数
   ch = 0
   For i = n To 0 Step -1
       If i > 4 Then
       j = i - 5
       For k = 5 To i - 5 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       Else
       j = 1
       For k = i - 1 To 0 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       End If
       c(i) = (ch + cy) Mod 10000
       cy = (ch + cy) \ 10000 'キャリー
       ch = 0
   Next i
End Sub


Sub macro_long_div(a() As Variant, c() As Variant, e() As Variant)
    Dim i As Integer, j As Integer, k As Integer
    Dim o As Integer, p As Integer, q As Integer, s As Integer, t As Integer

   'a()の数字が格納されている桁を求める
    i = 0
    Do Until a(i) > 0
    i = i + 1
    Loop

   'c()の数字が格納されている桁を求める
    o = 0
    Do Until c(o) > 0
    o = o + 1
    Loop

    k = o
    s = 0
    e(s) = 0
    s = s + 1

    'c()の桁の先頭の値を多めに持たせる
    c(k + 1) = c(k + 1) + c(k) * 10000
    c(k) = 0
    k = k + 1

    'c()の添え字がa()の添え字と同じになるまで繰り返し割る
    Do Until n - k = 0
        If c(k) > a(i) Then
            p = c(k) \ a(i)

            For q = i To 5
                If c(k) < p * a(q) Then     'p倍のa(q)の方が大きいときは一つ上の桁から引く
                    If c(k - 1) < (p * a(q)) \ 10000 Then   'p倍のa(q)の方がさらに大きいときはさらに一つ上の桁から引く
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000    'そんなに大きくないが10000より大き時の処理

                    If c(k) < (p * a(q)) Mod 10000 Then '10000の除算よりc(k)が小さいときの処理
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)  'なんでもない時はp倍したa(q)を引く
                End If
                If c(k) < p * a(q + 1) Then 'c(k)の桁が次のp倍したa(q)より小さい時だけkを進める
                    k = k + 1
                End If
            Next q
        Else
            c(k + 1) = c(k + 1) + c(k) * 10000
            c(k) = 0
            k = k + 1
        End If
                e(s) = p    '余りを格納
                s = s + 1

        If (c(k) \ 10000) > 1 Then  'c(k)が10000より大きいときは一つ上の桁に数値を戻す(オーバーフロー対策
            c(k - 1) = c(k) \ 10000
            c(k) = c(k) Mod 10000
        End If
                t = k
                k = o
        Do Until c(k) > 1   'c()の先頭の桁の添え字を求める
            k = k + 1
            If k = n Then



   For q = k To n
                    e(s) = 0
                    s = s + 1
                Next q
     End if
                Exit Do
            End If
        Loop

If n - k = 5 - i Then
    If c(k) \ 10000 > 0 Then
    p = c(k) \ a(i)
    For q = i To 5
If c(k) < p * a(q) Then
                    If c(k - 1) < (p * a(q)) \ 10000 Then   'p倍のa(q)の方がさらに大きいときはさらに一つ上の桁から引く
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000    'そんなに大きくないが10000より大き時の処理

                    If c(k) < (p * a(q)) Mod 10000 Then '10000の除算よりc(k)が小さいときの処理
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)  'なんでもない時はp倍したa(q)を引く
                End If
                If c(k) < p * a(q + 1) Then 'c(k)の桁が次のp倍したa(q)より小さい時だけkを進める
                    k = k + 1
                End If
    Next q
    e(s) = p
    s = s + 1
   Else
                For q = k To n
                    e(s) = 0
                    s = s + 1
                Next q
     End if
                Exit Do
            End If
        Loop
    'Loop

    'e()の整形
    q = 0
    Do Until q = n
        If (e(q) \ 10000) > 0 Then
            cy = e(q) \ 10000
            e(q) = e(q) - cy * 10000
            e(q - 1) = e(q - 1) + cy
        End If
        q = q + 1
    Loop
End Sub
Sub disp(c() As Variant, ir As Variant)   'ロング数の表示
   Dim i As Integer
   For i = 0 To n
       Cells(ir, ics + i).Value = c(i)
       Cells(ir, ics + i).NumberFormatLocal = "0000"
   Next i
End Sub
Sub disp_h(num As Integer, ir As Integer)   'ロング数の表示
   Dim i As Integer
   Dim ch As String
   ch = "b"
   If num = 1 Then
   ch = "a"
   End If
   For i = 0 To 5
       Cells(ir, ics + i).Value = ch & "(" & Str(i) & ")"
   Next i
End Sub
Sub multi_div()
   Dim a(n) As Variant
   Dim b(n) As Variant, c(n) As Variant, d(n) As Variant, e(n) As Variant, f(n) As Variant
   Dim i As Integer
   Dim ir As Integer
   Dim num As Integer
   a(0) = 0: a(1) = 0: a(2) = 3050: a(3) = 2508: a(4) = 8080: a(5) = 1233
   'a(0) = 0: a(1) = 0: a(2) = 0: a(3) = 0: a(4) = 0: a(5) = 1233
   'b(0) = 0: b(1) = 0: b(2) = 101: b(3) = 101: b(4) = 101: b(5) = 101
   b(0) = 0: b(1) = 0: b(2) = 0: b(3) = 0: b(4) = 0: b(5) = 1233
   d(0) = 0: d(1) = 0: d(2) = 0: d(3) = 0: d(4) = 0: d(5) = 0 '初期化
   ir = 2 'irは何行目から表示するか?

   'a()のNL向けf()配列
    For i = 0 To n
        If i < 5 Then
            f(i) = 0
        Else
            f(i) = a(i - 5)
        End If
    Next i
'-----------
   disp_h 1, 1
   Cells(ir, 1).Value = "a()=" 'irの1個下の行からa()を表示
   disp a(), ir                'dispはa()の計算式を表示させるコマンド,の後ろは上で指定した行に計算させるという意味
'-----------
   ir = ir + 2
   disp_h 2, 3
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 2
   Cells(ir, 1).Value = "a()="
   disp a(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "a()*b()="
   macro_long_mul a(), b(), c()
   disp c(), ir
'-----------
   ir = ir + 2
   disp f(), ir
   Cells(ir, 1).Value = "a()*b()/b()="
'-----------
   For i = 0 To n
       c(i) = Cells(14, ics + i).Value
    '  Cells(ir, ics + i).NumberFormatLocal ="0000"
    Next i
    Cells(15,1).Value = "c()="
      disp c(), 15
  ir = ir + 1
   Cells(ir, 1).Value = "shou()="

   macro_long_div b(), c(), e()
Cells(16, 1).Value ="c()="
   disp c(), 16
Cells(17, 1).Value ="e()="
   disp e(), 17
   'macro_long_div a(), c(), e()
   disp e(), ir
   disp c(), ir + 1
   Cells(ir + 1, 1).Value = "amari()="
'-----------
End Sub
 

保存4修正

 投稿者:けんいち  投稿日:2008年12月15日(月)02時47分50秒
  Const KETA = 20                 '桁数
Const n = (KETA - 1) \ 2 + 1    '配列サイズ
Const ics = 2
Sub macro_long_mul(a() As Variant, b() As Variant, c() As Variant)
   Dim cy As Long, i As Integer
   Dim ch As Long
   Dim j As Integer
   Dim k As Integer
   Dim l As Integer

   cy = 0    'ロング数*ショート数
   ch = 0
   For i = n To 0 Step -1
       If i > 4 Then
       j = i - 5
       For k = 5 To i - 5 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       Else
       j = 1
       For k = i - 1 To 0 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       End If
       c(i) = (ch + cy) Mod 10000
       cy = (ch + cy) \ 10000 'キャリー
       ch = 0
   Next i
End Sub
Sub macro_long_div(a() As Variant, c() As Variant, e() As Variant)
    Dim i As Integer, j As Integer, k As Integer
    Dim o As Integer, p As Integer, q As Integer, s As Integer

   'a()の数字が格納されている桁を求める
    i = 0
    Do Until a(i) > 0
    i = i + 1
    Loop

   'c()の数字が格納されている桁を求める
    o = 0
    Do Until c(o) > 0
    o = o + 1
    Loop

    k = o
    s = 0

    'c()の桁の先頭の値を多めに持たせる
    c(k + 1) = c(k + 1) + c(k) * 10000
    c(k) = 0
    k = k + 1

    'c()の添え字がa()の添え字と同じになるまで繰り返し割る
    Do Until n - k < 4
        If c(k) > a(i) Then
            p = c(k) \ a(i)

            For q = i To 5
                If c(k) < p * a(q) Then     'p倍のa(q)の方が大きいときは一つ上の桁から引く
                    If c(k - 1) < (p * a(q)) \ 10000 Then   'p倍のa(q)の方がさらに大きいときはさらに一つ上の桁から引く
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000    'そんなに大きくないが10000より大き時の処理

                    If c(k) < (p * a(q)) Mod 10000 Then '10000の除算よりc(k)が小さいときの処理
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)  'なんでもない時はp倍したa(q)を引く
                End If
                If c(k) < p * a(q + 1) Then 'c(k)の桁が次のp倍したa(q)より小さい時だけkを進める
                    k = k + 1
                End If
            Next q
        Else
            c(k + 1) = c(k + 1) + c(k) * 10000
            c(k) = 0
            k = k + 1
        End If

                e(s) = p    '余りを格納
                s = s + 1

        If (c(k) \ 10000) > 1 Then  'c(k)が10000より大きいときは一つ上の桁に数値を戻す(オーバーフロー対策
            c(k - 1) = c(k) \ 10000
            c(k) = c(k) Mod 10000
        End If

                k = o
        Do Until c(k) > 1   'c()の先頭の桁の添え字を求める
            k = k + 1
        Loop

    Loop


    'a()の桁とc()の桁が同じになったときの計算(内容は上のやつの一部)
    p = c(k) \ a(i)

                For q = i To 5
                If c(k) < p * a(q) Then
                    If c(k - 1) < (p * a(q)) \ 10000 Then
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000

                    If c(k) < (p * a(q)) Mod 10000 Then
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)
                End If
                If c(k) < p * a(q + 1) Then
                    k = k + 1
                End If
            Next q

    e(s) = p


End Sub

Sub disp(c() As Variant, ir As Variant)   'ロング数の表示
   Dim i As Integer
   For i = 0 To n
       Cells(ir, ics + i).Value = c(i)
       Cells(ir, ics + i).NumberFormatLocal = "0000"
   Next i
End Sub
Sub disp_h(num As Integer, ir As Integer)   'ロング数の表示
   Dim i As Integer
   Dim ch As String
   ch = "b"
   If num = 1 Then
   ch = "a"
   End If
   For i = 0 To 5
       Cells(ir, ics + i).Value = ch & "(" & Str(i) & ")"
   Next i
End Sub
Sub multi_div()
   Dim a(n) As Variant
   Dim b(n) As Variant, c(n) As Variant, d(n) As Variant, e(n) As Variant, f(n) As Variant
   Dim i As Integer
   Dim ir As Integer
   Dim num As Integer
   a(0) = 0: a(1) = 0: a(2) = 3050: a(3) = 2508: a(4) = 8080: a(5) = 1233
   b(0) = 0: b(1) = 0: b(2) = 101: b(3) = 101: b(4) = 101: b(5) = 101
   d(0) = 0: d(1) = 0: d(2) = 0: d(3) = 0: d(4) = 0: d(5) = 0 '初期化
   ir = 2 'irは何行目から表示するか?

   'a()のNL向けf()配列
    For i = 0 To n
        If i < 5 Then
            f(i) = 0
        Else
            f(i) = a(i - 5)
        End If
    Next i


'-----------
   disp_h 1, 1
   Cells(ir, 1).Value = "a()=" 'irの1個下の行からa()を表示
   disp a(), ir                'dispはa()の計算式を表示させるコマンド,の後ろは上で指定した行に計算させるという意味
'-----------
   ir = ir + 2
   disp_h 2, 3
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 2
   Cells(ir, 1).Value = "a()="
   disp a(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "a()*b()="
   macro_long_mul a(), b(), c()
   disp c(), ir
'-----------
   ir = ir + 2
   disp f(), ir
   Cells(ir, 1).Value = "a()*b()/b()="
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "shou()="
   macro_long_div a(), c(), e()
   disp e(), ir
   disp c(), ir + 1
   Cells(ir + 1, 1).Value = "amari()="
'-----------
End Sub
 

http://www.geocities.jp/proton_110/aidem/programa/ex3.txt

 投稿者:けんいち  投稿日:2008年12月15日(月)02時18分16秒
  Const KETA = 20                 '桁数
Const n = (KETA - 1) \ 2 + 1    '配列サイズ
Const ics = 2
Sub lmul(a() As Variant, b() As Variant, c() As Variant)
   Dim cy As Long, i As Integer
   Dim ch As Long
   Dim j As Integer
   Dim k As Integer
   Dim l As Integer

   cy = 0    'ロング数*ショート数
   ch = 0
   For i = n To 0 Step -1
       If i > 4 Then
       j = i - 5
       For k = 5 To i - 5 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       Else
       j = 1
       For k = i - 1 To 0 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       End If
       c(i) = (ch + cy) Mod 10000
       cy = (ch + cy) \ 10000 'キャリー
       ch = 0
   Next i
End Sub
Sub ldiv(a() As Variant, c() As Variant, e() As Variant)
    Dim i As Integer, j As Integer, k As Integer
    Dim o As Integer, p As Integer, q As Integer, s As Integer

   'a()の数字が格納されている桁を求める
    i = 0
    Do Until a(i) > 0
    i = i + 1
    Loop

   'c()の数字が格納されている桁を求める
    o = 0
    Do Until c(o) > 0
    o = o + 1
    Loop

    k = o
    s = 0

    'c()の桁の先頭の値を多めに持たせる
    c(k + 1) = c(k + 1) + c(k) * 10000
    c(k) = 0
    k = k + 1

    'c()の添え字がa()の添え字と同じになるまで繰り返し割る
    Do Until n - k < 4
        If c(k) > a(i) Then
            p = c(k) \ a(i)

            For q = i To 5
                If c(k) < p * a(q) Then     'p倍のa(q)の方が大きいときは一つ上の桁から引く
                    If c(k - 1) < (p * a(q)) \ 10000 Then   'p倍のa(q)の方がさらに大きいときはさらに一つ上の桁から引く
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000    'そんなに大きくないが10000より大き時の処理

                    If c(k) < (p * a(q)) Mod 10000 Then '10000の除算よりc(k)が小さいときの処理
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)  'なんでもない時はp倍したa(q)を引く
                End If
                If c(k) < p * a(q + 1) Then 'c(k)の桁が次のp倍したa(q)より小さい時だけkを進める
                    k = k + 1
                End If
            Next q
        Else
            c(k + 1) = c(k + 1) + c(k) * 10000
            c(k) = 0
            k = k + 1
        End If

                e(s) = p    '余りを格納
                s = s + 1

        If (c(k) \ 10000) > 1 Then  'c(k)が10000より大きいときは一つ上の桁に数値を戻す(オーバーフロー対策
            c(k - 1) = c(k) \ 10000
            c(k) = c(k) Mod 10000
        End If

                k = o
        Do Until c(k) > 1   'c()の先頭の桁の添え字を求める
            k = k + 1
        Loop

    Loop


    'a()の桁とc()の桁が同じになったときの計算(内容は上のやつの一部)
    p = c(k) \ a(i)

                For q = i To 5
                If c(k) < p * a(q) Then
                    If c(k - 1) < (p * a(q)) \ 10000 Then
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000

                    If c(k) < (p * a(q)) Mod 10000 Then
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)
                End If
                If c(k) < p * a(q + 1) Then
                    k = k + 1
                End If
            Next q

    e(s) = p


End Sub

Sub disp(c() As Variant, ir As Variant)   'ロング数の表示
   Dim i As Integer
   For i = 0 To n
       Cells(ir, ics + i).Value = c(i)
       Cells(ir, ics + i).NumberFormatLocal = "0000"
   Next i
End Sub
Sub disp_h(num As Integer, ir As Integer)   'ロング数の表示
   Dim i As Integer
   Dim ch As String
   ch = "b"
   If num = 1 Then
   ch = "a"
   End If
   For i = 0 To n
       Cells(ir, ics + i).Value = ch & "(" & Str(i) & ")"
   Next i
End Sub
Sub multi_div()
   Dim a(n) As Variant
   Dim b(n) As Variant, c(n) As Variant, d(n) As Variant, e(n) As Variant, f(n) As Variant
   Dim i As Integer
   Dim ir As Integer
   Dim num As Integer
   a(0) = 0: a(1) = 0: a(2) = 3050: a(3) = 2508: a(4) = 8080: a(5) = 1233
   b(0) = 0: b(1) = 0: b(2) = 101: b(3) = 101: b(4) = 101: b(5) = 101
   d(0) = 0: d(1) = 0: d(2) = 0: d(3) = 0: d(4) = 0: d(5) = 0 '初期化
   ir = 2 'irは何行目から表示するか?

   'a()のNL向けf()配列
    For i = 0 To n
        If i < 5 Then
            f(i) = 0
        Else
            f(i) = a(i - 5)
        End If
    Next i


'-----------
   disp_h 1, 1
   Cells(ir, 1).Value = "a()=" 'irの1個下の行からa()を表示
   disp a(), ir                'dispはa()の計算式を表示させるコマンド,の後ろは上で指定した行に計算させるという意味
'-----------
   ir = ir + 2
   disp_h 2, 3
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 2
   Cells(ir, 1).Value = "a()="
   disp a(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "a()*b()="
   lmul a(), b(), c()
   disp c(), ir
'-----------
   ir = ir + 2
   disp f(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "shou()="
   ldiv a(), c(), e()
   disp e(), ir
   disp c(), ir + 1
'-----------
End Sub
 

ホゾン4

 投稿者:けんいち  投稿日:2008年12月15日(月)02時15分9秒
  Const KETA = 20                 '桁数
Const n = (KETA - 1) \ 2 + 1    '配列サイズ
Const ics = 2
Sub lmul(a() As Variant, b() As Variant, c() As Variant)
   Dim cy As Long, i As Integer
   Dim ch As Long
   Dim j As Integer
   Dim k As Integer
   Dim l As Integer

   cy = 0    'ロング数*ショート数
   ch = 0
   For i = n To 0 Step -1
       If i > 4 Then
       j = i - 5
       For k = 5 To i - 5 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       Else
       j = 1
       For k = i - 1 To 0 Step -1
           ch = a(j) * b(k) + ch
           j = j + 1
       Next k
       End If
       c(i) = (ch + cy) Mod 10000
       cy = (ch + cy) \ 10000 'キャリー
       ch = 0
   Next i
End Sub
Sub ldiv(a() As Variant, c() As Variant, e() As Variant)
    Dim i As Integer, j As Integer, k As Integer
    Dim o As Integer, p As Integer, q As Integer, s As Integer

   'a()の数字が格納されている桁を求める
    i = 0
    Do Until a(i) > 0
    i = i + 1
    Loop

   'c()の数字が格納されている桁を求める
    o = 0
    Do Until c(o) > 0
    o = o + 1
    Loop

    k = o
    s = 0

    'c()の桁の先頭の値を多めに持たせる
    c(k + 1) = c(k + 1) + c(k) * 10000
    c(k) = 0
    k = k + 1

    'c()の添え字がa()の添え字と同じになるまで繰り返し割る
    Do Until n - k < 4
        If c(k) > a(i) Then
            p = c(k) \ a(i)

            For q = i To 5
                If c(k) < p * a(q) Then     'p倍のa(q)の方が大きいときは一つ上の桁から引く
                    If c(k - 1) < (p * a(q)) \ 10000 Then   'p倍のa(q)の方がさらに大きいときはさらに一つ上の桁から引く
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000    'そんなに大きくないが10000より大き時の処理

                    If c(k) < (p * a(q)) Mod 10000 Then '10000の除算よりc(k)が小さいときの処理
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)  'なんでもない時はp倍したa(q)を引く
                End If
                If c(k) < p * a(q + 1) Then 'c(k)の桁が次のp倍したa(q)より小さい時だけkを進める
                    k = k + 1
                End If
            Next q
        Else
            c(k + 1) = c(k + 1) + c(k) * 10000
            c(k) = 0
            k = k + 1
        End If

                e(s) = p    '余りを格納
                s = s + 1

        If (c(k) \ 10000) > 1 Then  'c(k)が10000より大きいときは一つ上の桁に数値を戻す(オーバーフロー対策
            c(k - 1) = c(k) \ 10000
            c(k) = c(k) Mod 10000
        End If

                k = o
        Do Until c(k) > 1   'c()の先頭の桁の添え字を求める
            k = k + 1
        Loop

    Loop


    'a()の桁とc()の桁が同じになったときの計算(内容は上のやつの一部)
    p = c(k) \ a(i)

                For q = i To 5
                If c(k) < p * a(q) Then
                    If c(k - 1) < (p * a(q)) \ 10000 Then
                        c(k - 1) = c(k - 2) * 10000
                        c(k - 2) = 0
                    End If

                    c(k - 1) = c(k - 1) - (p * a(q)) \ 10000

                    If c(k) < (p * a(q)) Mod 10000 Then
                        c(k) = c(k) + c(k - 1) * 10000
                        c(k - 1) = 0
                    End If
                    c(k) = c(k) - ((p * a(q)) Mod 10000)
                Else
                    c(k) = c(k) - p * a(q)
                End If
                If c(k) < p * a(q + 1) Then
                    k = k + 1
                End If
            Next q

    e(s) = p


End Sub

Sub disp(c() As Variant, ir As Variant)   'ロング数の表示
   Dim i As Integer
   For i = 0 To n
       Cells(ir, ics + i).Value = c(i)
       Cells(ir, ics + i).NumberFormatLocal = "0000"
   Next i
End Sub
Sub disp_h(num As Integer, ir As Integer)   'ロング数の表示
   Dim i As Integer
   Dim ch As String
   ch = "b"
   If num = 1 Then
   ch = "a"
   End If
   For i = 0 To n
       Cells(ir, ics + i).Value = ch & "(" & Str(i) & ")"
   Next i
End Sub
Sub multi_div()
   Dim a(n) As Variant
   Dim b(n) As Variant, c(n) As Variant, d(n) As Variant, e(n) As Variant, f(n) As Variant
   Dim i As Integer
   Dim ir As Integer
   Dim num As Integer
   a(0) = 0: a(1) = 0: a(2) = 3050: a(3) = 2508: a(4) = 8080: a(5) = 1233
   b(0) = 0: b(1) = 0: b(2) = 101: b(3) = 101: b(4) = 101: b(5) = 101
   d(0) = 0: d(1) = 0: d(2) = 0: d(3) = 0: d(4) = 0: d(5) = 0 '初期化
   ir = 2 'irは何行目から表示するか?

   'a()のNL向けf()配列
    For i = 0 To n
        If i < 5 Then
            f(i) = 0
        Else
            f(i) = a(i - 5)
        End If
    Next i


'-----------
   disp_h 1, 1
   Cells(ir, 1).Value = "a()=" 'irの1個下の行からa()を表示
   disp a(), ir                'dispはa()の計算式を表示させるコマンド,の後ろは上で指定した行に計算させるという意味
'-----------
   ir = ir + 2
   disp_h 2, 3
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 2
   Cells(ir, 1).Value = "a()="
   disp a(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "a()*b()="
   lmul a(), b(), c()
   disp c(), ir
'-----------
   ir = ir + 2
   disp f(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "shou()="
   ldiv a(), c(), e()
   disp e(), ir
   disp c(), ir + 1
'-----------
End Sub
 

保存3

 投稿者:けんいち  投稿日:2008年12月13日(土)22時48分9秒
  Const KETA = 20 '桁数
Const N = (KETA - 1) \ 2 + 1 '配列サイズ
Const ics = 2
Sub lmul(a() As Variant, b As Variant, c() As Variant)
     Dim cy As Long, i As Integer
     Dim ch As Long
     Dim j As Integer
     Dim k As Integer
        Dim l As Integer

        cy = 0 'ロング数*ショート数
        ch = 0
        For i = N To 0 Step -1
            If i > 4 Then
        l = i - 5
        j = l
            For k = 5 To l Step -1
            ch = a(j) * b(k) + ch
            j = j + 1
            Next k
         Else
        j = 1
            For k = i - 1 To 0 Step -1
            ch = a(j) * b(k) + ch
            j = j + 1
            Next k
    End If
    c(i) = (ch + cy) Mod 10000
    cy = (ch + cy) \ 10000 'キャリー
    ch = 0
    Next i
    End Sub
Sub ldiv(a() As Variant, b() As Variant, c() As Variant, d() As Variant)
Dim r As Variant, i As Variant
r = 0 'ロング数÷ショート数
If c(i) = 0 Then
Else
For i = 0 To N
b(i) = (a(i) + r) \ c(i) '商
r = ((a(i) + r) Mod c(i)) * 10000 '余りの処理
d(i) = r
Next i
End If
End Sub
Sub disp(c() As Variant, ir As Variant) 'ロング数の表示
Dim i As Integer
For i = 0 To N
Cells(ir, ics + i).Value = c(i)
Cells(ir, ics + i).NumberFormatLocal = "0000"
Next i
End Sub
Sub disp_h(num As Integer, ir As Integer) 'ロング数の表示
Dim i As Integer
Dim ch As String
ch = "b"
If num = 1 Then
ch = "a"
End If
For i = 0 To N
Cells(ir, ics + i).Value = ch & "(" & Str(i) & ")"
Next i
End Sub
Sub multi_div()
Dim a(N) As Variant
Dim b(N) As Variant, c(N) As Variant, d(N) As Variant
Dim i As Integer
Dim ir As Integer
Dim num As Integer
a(0) = 0: a(1) = 0: a(2) = 3050: a(3) = 2508: a(4) = 8080: a(5) = 1233
b(0) = 0: b(1) = 0: b(2) = 101: b(3) = 101: b(4) = 101: b(5) = 101
d(0) = 0: d(1) = 0: d(2) = 0: d(3) = 0: d(4) = 0: d(5) = 0 '初期化
ir = 2 'irは何行目から表示するか?
'-----------
disp_h 1, 1
Cells(ir, 1).Value = "a()="  'irの1個下の行からa()を表示
disp a(), ir 'dispはa()の計算式を表示させるコマンド,の後ろは上で指定した行に計算させるという意味
'-----------
ir = ir + 2
disp_h 2, 3
Cells(ir, 1).Value = "b()="
disp b(), ir
'-----------
ir = ir + 2
Cells(ir, 1).Value = "a()="
disp a(), ir
ir = ir + 1
Cells(ir, 1).Value = "b()="
disp b(), ir
'-----------
ir = ir + 1
Cells(ir, 1).Value = "a()*b()="
lmul a(), b(), c()
disp c(), ir
'-----------
ir = ir + 2
ir = ir + 1
Cells(ir, 1).Value = "shou()="
ldiv a(), c(), b(), d()
disp b(), ir
'-----------
ir = ir + 1
Cells(ir, 1).Value = "amari()="
ldiv a(), c(), b(), d()
disp d(), ir
'-----------
End Sub
 

保存

 投稿者:けんいち  投稿日:2008年12月11日(木)23時51分8秒
  Const KETA = 20                 '桁数
Const N = (KETA - 1) \ 2 + 1    '配列サイズ
Const ics = 2
Sub lmul(a() As Variant, b() As Variant, c() As Variant)
   Dim cy As Variant, i As Variant
   Dim d As Variant
   cy = 0                      'ロング数*ショート数
   For i = 0 To N
       d = a(i)
       c(i) = (d * b(i) + cy) Mod 10000 'c(i)=(d×b+cy)を計算のあと余りに10000を掛ける
       cy = (d * b(i) + cy) \ 10000 'キャリー
   Next i
End Sub
Sub ldiv(a() As Variant, b() As Variant, c() As Variant, d() As Variant)
   Dim r As Variant, i As Variant
   r = 0                        'ロング数÷ショート数
   If c(i) = 0 Then
   Else
   For i = 0 To N
       b(i) = (a(i) + r) \ c(i)         '商
       r = ((a(i) + r) Mod c(i)) * 10000 '余りの処理
       d(i) = r
   Next i
   End If
End Sub

Sub disp(c() As Variant, ir As Variant)   'ロング数の表示
   Dim i As Variant
   For i = 0 To N
       Cells(ir, ics + i).Value = c(i)
       Cells(ir, ics + i).NumberFormatLocal = "0000"
   Next i
End Sub
Sub disp_h(num As Variant, ir As Variant)   'ロング数の表示
   Dim i As Variant
   Dim ch As Variant
   ch = "b"
   If num = 1 Then
   ch = "a"
   End If
   For i = 0 To N
       Cells(ir, ics + i).Value = ch & "(" & Str(i) & ")"
   Next i
End Sub
Sub multi_div()
   Dim a(N) As Variant, b(N) As Variant, c(N) As Variant, d(N) As Variant
   Dim i As Variant
   Dim ir As Variant
   Dim num As Variant
   a(0) = 0: a(1) = 0: a(2) = 3050: a(3) = 2508: a(4) = 8080: a(5) = 1233
   b(0) = 0: b(1) = 0: b(2) = 101: b(3) = 101: b(4) = 101: b(5) = 101
   d(0) = 0: d(1) = 0: d(2) = 0: d(3) = 0: d(4) = 0: d(5) = 0 '初期化
   ir = 2 'irは何行目から表示するか?
'-----------
   disp_h 1, 1
   Cells(ir, 1).Value = "a()=" 'irの1個下の行からa()を表示
   disp a(), ir                'dispはa()の計算式を表示させるコマンド,の後ろは上で指定した行に計算させるという意味
'-----------
   ir = ir + 2
   disp_h 2, 3
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 2
   Cells(ir, 1).Value = "a()="
   disp a(), ir
   ir = ir + 1
   Cells(ir, 1).Value = "b()="
   disp b(), ir
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "a()*b()="
   lmul a(), b(), c()
   disp c(), ir
'-----------
   ir = ir + 2
   ir = ir + 1
   Cells(ir, 1).Value = "shou()="
   ldiv a(), c(), b(), d()
   disp b(), ir
'-----------
   ir = ir + 1
   Cells(ir, 1).Value = "amari()="
      ldiv a(), c(), b(), d()
   disp d(), ir
'-----------
End Sub
 

QMA

 投稿者:たまちゃ  投稿日:2008年 9月 5日(金)22時45分49秒
  http://www12.atwiki.jp/qma5/

↑QMA攻略サイト
 

レンタル掲示板
/10