• 車種別
  • パーツ
  • 整備手帳
  • ブログ
  • みんカラ+

けーすけ@北海道のブログ一覧

2009年01月14日 イイね!

ここまでできるマイクロソフトエクセル

ここまでできるマイクロソフトエクセルネットでいろいろ公開されているソースを、参考にしています。

EXCELを起動後、「Alt+F11」でVBE(Visual Basic Editor)が開きます。
「挿入」から「標準モジュール」を選んで、次のソースを貼り付けてください。

その後、EXCELに戻って「マクロ」で表示されているマクロを実行してください。

もしかすると、予定していない箇所で改行されてしまい、うまく動作しないかもしれません。

その時は、自分で編集してみてね。
ъ( ゜ー^)ニコッ


'----- ここからソース -----
'変数宣言を強制
Option Explicit
'定数
Private Const total As Integer = 3
'変数
Private cnt As Integer 'カウンター
Private pole(1) As Integer '棒
Private bottom_cell(3) As Integer '各棒の円盤の位置

'--- ハノイの塔スタート --------------
Public Sub Hanoi_Start()

'ビジュアルの準備
Call Set_Pole
Call Set_Discuss
Const n As Integer = 4 '円盤の数
cnt = 0 '初期化
Call Hanoi(n, 0, 1)

End Sub

'--- ハノイの塔本体 ------------------
' 引数
' n:円盤の番号
' a:移動元作業棒
' b:移動先作業棒
'-------------------------------------
Private Sub Hanoi(ByRef n As Variant, ByRef a As Variant, ByRef b As Variant)

If n > 0 Then
Call Hanoi(n - 1, a, total - (a + b))
cnt = cnt + 1 'カウントアップ
pole(0) = Asc("a") + a
pole(1) = Asc("a") + b
'円盤の移動をセルに書き出し
Cells(cnt, 1).Value = n & "番の円盤を" & Chr(pole(0)) & "から" & Chr(pole(1)) & "に移動"
'円盤を移動
Call Move_Discuss(n, pole(0), pole(1))
Call Hanoi(n - 1, total - (a + b), b)
End If

End Sub

'--- 作業棒の設定 --------------------
Private Sub Set_Pole()

'幅調整
Range(Cells(1, 4), Cells(41)).ColumnWidth = 1
'棒aの定義
Range(Cells(4, 12), Cells(8, 12)).ColumnWidth = 0.5
Cells(10, 12).Value = "a"
'棒bの定義
Range(Cells(4, 24), Cells(8, 24)).ColumnWidth = 0.5
Cells(10, 24).Value = "b"
'棒cの定義
Range(Cells(4, 36), Cells(8, 36)).ColumnWidth = 0.5
Cells(10, 36).Value = "c"

End Sub

'--- 最初の円盤を配置 ----------------
Private Sub Set_Discuss()

Range(Cells(5, 11), Cells(5, 13)).Interior.ColorIndex = 1 * 3 '1番目の円盤
Range(Cells(6, 10), Cells(6, 14)).Interior.ColorIndex = 2 * 3 '2番目の円盤
Range(Cells(7, 9), Cells(8, 15)).Interior.ColorIndex = 3 * 3 '3番目の円盤
Range(Cells(8, 8), Cells(8, 16)).Interior.ColorIndex = 4 * 3 '4番目の円盤
'最初の各円盤の位置の初期値を代入
bottom_cell(0) = 5
bottom_cell(1) = 6
bottom_cell(2) = 7
bottom_cell(3) = 8

End Sub

'--- 円盤を移動 ----------------------
' 引数
' n:円盤(1-4)
' a:移動元作業棒(97-99)
' b:移動先作業棒(97-99)
'-------------------------------------
Private Sub Move_Discuss(ByVal n As Integer, ByVal a As Integer, ByVal b As Integer)

Dim i As Long
Dim col(1) As Integer
col(0) = 12 * (a - 96)
col(1) = 12 * (b - 96)
'上に移動
For i = 1000000 To 6000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), col(0) - n), Cells(bottom_cell(n - 1), col(0) + n)).Interior.ColorIndex = xlNone
bottom_cell(n - 1) = bottom_cell(n - 1) - 1
Range(Cells(bottom_cell(n - 1), col(0) - n), Cells(bottom_cell(n - 1), col(0) + n)).Interior.ColorIndex = n * 3
If bottom_cell(n - 1) = 3 Then Exit For
End If
Next
'横に移動
If col(1) - col(0) > 0 Then
For i = col(0) * 1000000 To col(1) * 1000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), i / 1000000 - n + 1), Cells(bottom_cell(n - 1), i / 1000000 + n)).Interior.ColorIndex = n * 3
Cells(bottom_cell(n - 1), i / 1000000 - n).Interior.ColorIndex = xlNone
End If
Next
Else
For i = col(0) * 1000000 To col(1) * 1000000 Step -1
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), i / 1000000 - n), Cells(bottom_cell(n - 1), i / 1000000 + n + 1)).Interior.ColorIndex = n * 3
Cells(bottom_cell(n - 1), i / 1000000 + n + 1).Interior.ColorIndex = xlNone
End If
Next
End If
'下に移動
For i = 1000000 To 6000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), col(1) - n), Cells(bottom_cell(n - 1), col(1) + n)).Interior.ColorIndex = xlNone
bottom_cell(n - 1) = bottom_cell(n - 1) + 1
Range(Cells(bottom_cell(n - 1), col(1) - n), Cells(bottom_cell(n - 1), col(1) + n)).Interior.ColorIndex = n * 3
If Range(Cells(bottom_cell(n - 1) + 1, col(1) - n), Cells(bottom_cell(n - 1) + 1, col(1) + n)).Interior.ColorIndex <> xlNone Or bottom_cell(n - 1) = 8 Then Exit For
End If
Next

End Sub

'/*----- ここまでソース -----*/

「ハノイの塔」って知っています???

1月16日に、終了時の画像を追加しました。
Posted at 2009/01/14 08:42:37 | コメント(0) | トラックバック(0) | 一般 | パソコン/インターネット
2009年01月09日 イイね!

放射冷却現象

画像はありませんが、今朝は9時を過ぎてもダイヤモンド・ダストが見られたなあ。

{{{(^。^)}}}サムイヨー!
Posted at 2009/01/09 11:21:20 | コメント(3) | トラックバック(0) | 一般 | 旅行/地域
2009年01月08日 イイね!

もうすぐ氷柱

もうすぐ氷柱おがったなあ~~~。
Posted at 2009/01/08 12:21:45 | コメント(2) | トラックバック(0) | 一般 | 旅行/地域
2009年01月07日 イイね!

セルフ

昨日、久しぶりに妻と夕食の買い物をしました。

ガソリンスタンドのセルフは、もう定着しています。
通常より安いしね。

スーパーのレジにもセルフが登場した。
妻に聞くと、「昨年からだよ。」

σ(^^)、「何かおまけがあるの???」
妻、「特に何も。」

σ(^^)、「なして自分でやるの???」
妻、「空いているから。」

通常のレジも空いていたけれど...
?(゜_。)?(。_゜)?

当然、レジを通すときに、値引きされるわけでもない。どうやら”エコポイント”なるものが貰えるらしいのだけれど、その換金率が記されていない。

σ(^^)、「何かメリットでもあるの???」
妻、「わからない。」

?(゜_。)?(。_゜)?

もしかして、店側の経費節減による利益確保に、ボランティア状態で消費者が協力しているだけ!?

まったく意味が無い!!!
( ̄‥ ̄)フンッ!
Posted at 2009/01/07 09:38:05 | コメント(6) | トラックバック(0) | 一般 | ショッピング
2009年01月05日 イイね!

耐寒限界

耐寒限界取り込みが悪いですが、マウントしていないポジフィルムです。
2箇所、真っ黒なコマがあります。

激寒のためリチウム電池が上がってしまって、シャッターボタンを押しましたが、シャッターが落ちていない状態になり、そのままフィルムが巻き上げられるため、真っ黒になっています。

続けて撮影するためには、スウィッチを切り(実は、このときフィルムが巻き上げられます)、手袋の中の替えのリチウム電池と交換して復活させます。

ワンショットごとに行わなければならないときもあり、上がったリチウム電池を手袋の中で暖めて電池を復活させますが、間に合わないときがあります。







コマの境界を、拡大したところです。



この現象が頻繁に起こるようになったので、EOS1Vを買い加えて17年使ったEOS10QZをサブ機にしました。今では氷点下5度くらいで、液晶のモニターが何も表示されなくなり、カメラが動作しなくなります。

経年変化で基盤関係が限界なんでしょうね。
今では、常温のときだけ使っています。

くぅっo(≧ヘ≦o)
Posted at 2009/01/05 17:32:20 | コメント(1) | トラックバック(0) | 写真 | 趣味

プロフィール

「確認 http://cvw.jp/b/364030/48469086/
何シテル?   06/05 08:50
写真が趣味であちこち出かけますが、愛車はSUVでなくセダンに乗っています。友人からは「何考えている。」と冷やかされております。
みんカラ新規会員登録

ユーザー内検索

<< 2009/1 >>

    12 3
4 56 7 8 910
111213 1415 16 17
18 19 20 212223 24
2526 27 28293031

リンク・クリップ

HRS(High Response Skyline) 
カテゴリ:クルマ
2008/09/12 11:08:03
 

愛車一覧

日産 スカイライン 日産 スカイライン
ATTESA E-TSに乗りたくて、250GT Fourにしました。 【黄芥子とスカG ...
ヘルプ利用規約サイトマップ
© LY Corporation