エクセラのEXCEL
表計算ソフトEXCELでゲーム等を作っています。ゲーム等の作成状況を紹介。
スポンサーサイト
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
再計算可能なセル変更関数

先日の関数を再計算にも対応させた。
あまりすっきりしたコードではないけど、名前定義を利用して、関数もどきの再計算をさせている。


'標準モジュール
'使用例 =rotate(対象のセル範囲,回転角) 回転角は-90~90
Function rotate(a As Range, b)
    rotate = a.Address & "," & b
End Function


'シートモジュール
Private Sub Worksheet_Calculate()
    Dim a As Variant
    For Each n In ActiveWorkbook.Names
        If n.Name Like "rotate_*" Then
            f = Range(n.Name).Formula
            If f Like "*rotate(*,*)*" Then
                a = Split(Range(n.Name), ",")
                Range(a(0)).Orientation = a(1)
            End If
        End If
    Next
End Sub


Private Sub Worksheet_Change(ByVal target As Range)
    Dim a As Variant
    For Each ta In target
        f = ta.Formula
        If f Like "*rotate(*,*)*" Then
            a = Split(ta, ",")  'a(0)は対象のセル a(1)は回転角
            Range(a(0)).Orientation = a(1)
            ActiveWorkbook.Names.Add Name:="rotate_" & Replace(ta.Address, "$", ""), RefersTo:="=" & ta.Address
        End If
    Next
End Sub

スポンサーサイト

テーマ:EXCEL - ジャンル:コンピュータ

ユーザー定義関数でセルの内容を変更

関数でセルの内容を変更することはできませんが、以前、ユーザー定義関数(?)で強引にセルの内容を変更したことがあります。
次の例は、特定のセルの文字を回転させる関数(?)です。
なお再計算時には反映されません。

'標準モジュール
'使用例 =rotate(対象のセル範囲,回転角) 回転角は-90~90
Function rotate(a As Range, b As Long)
    rotate = a.Address & "," & b
End Function


'シートモジュール
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a As Variant
    For Each ta In Target
        f = ta.Formula
        If f Like "*rotate(*,*)*" Then
            a = Split(ta, ",")  'a(0)は対象のセル a(1)は回転角
            Range(a(0)).Orientation = a(1)
        End If
    Next
End Sub

テーマ:EXCEL - ジャンル:コンピュータ

クイズ・ドレミファドン!
APIのBEEPを使うと、EXCELで音楽を流すことができます。
果たして何の曲が流れてくるでしょうか?
やり方のわからない人は、メール下さい。

Declare Function beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub sound()
Dim a()
a = [{32,5,0,2,24,2,32,2,40,2,48,2,40,2,0,2,32,2,36,2,0,2,36,2,36,2,0,2,27,5,0,1,36,2,32,2,0,2,30,2,32,5,0,2,24,2,32,2,40,2,48,2,40,2,0,2,32,2,34,2,0,2,34,2,34,2,0,2,32,5}]
For i = 1 To UBound(a) Step 2
If a(i) = 0 Then
Sleep a(i + 1) * 80
Else
beep a(i) * 10, a(i + 1) * 80
End If
Next
End Sub
はじめて自分のために

よく他の人のためにEXCELのマクロを作っていたが、今回たぶんはじめて自分のためにマクロを作った。
内容は、EXCELファイルが300個あり、その中の特定のデータを抜き取り、ひとつのファイルにするものだった。
300個をマクロを使わずに行うと、5時間は掛かったと思う。


Sub test()
 af = ActiveWorkbook.Name
 sr = Range("A65535").End(xlUp).Row + 1
 Set fs = Application.FileSearch
 FileToOpen = Application.GetOpenFilename("ファイル (*.xls),*.xls", , "目的のフォルダーを開いてください")
 If FileToOpen <> False Then
  Application.ScreenUpdating = False
  With fs
   .LookIn = Left(FileToOpen, InStrRev(FileToOpen, "\"))
   .SearchSubFolders = False: .Filename = "*.xls"
   If .Execute() > 0 Then
    For i = 1 To .FoundFiles.Count
     Workbooks.Open Filename:=.FoundFiles(i)
     With Workbooks(af).Worksheets(1)
途中省略
      Range(Cells(j, 1), Cells(j, 25)).Copy (.Cells(sr, 1))
途中省略
    Windows(Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)).Close
     End With     
    Next
   End If
  End With    
 End If
End Sub


たったこれだけで、5時間が2分以下に。はじめてVBAを覚えてよかったと思った。


そうそう、ブログの更新だけでなく、ゲーム作りも忘れていた。

copyright © 2005 エクセラのEXCEL all rights reserved.
Powered by FC2ブログ.
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。