メモ

フーリエ変換の縦軸を正しい値に変換する

直流レベルはサンプリング数で割り、それ以外のデータは(サンプリング数/2)で割れば求めることが出来る。
http://oshiete.goo.ne.jp/qa/5777874.html
ちなみに周波数の幅は(サンプリング周波数/サンプリング数)である。

3Dグラフの奥行きを変更する

グラフエリアの書式設定 > 3D回転 > グラフのサイズ > 奥行き

から変更することが出来る。

勝手にファイルを開いてしまう(Excel2010)

なかなか悩んだが解決。エクセルのアイコンをダブルクリックすると、開きたいアイコンとは別のファイルを開いてしまう現象。開いてしまうファイルを削除すると~が見つかりません、と出て非常にうっとうしい。
regeditで

HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Excel\Options

にあるOpenキーを削除すれば解決。

ショートカット

Ctrl + PageUp/PageDown
シート移動
Alt + E + L
シート削除
Alt + E + S + V
値だけコピー
Alt E + I + S
オートフィル

行列の定義と覚え方

行と列がどちらか混乱することが多々合ったが、ようやく納得の行く覚え方を見つけた。文字を並べていく方向が行である。今書いている文章ならば、上から1行、2行となるし、エクセルでも、数学の行列でも全て同じである。文字を書いていく方向が行である。

オートフィルをダブルクリックで行う

非常に長い範囲をオートフィルするのが面倒くさい場合、オートフィルの四角いボタンをダブルクリックすることで自動的に入力することが出来る。ただし隣接している縦方向限定。

関数

近時直線を文字列にする

切片
=ROUNDUP(INTERCEPT(A1:A10,B1:B10),3)
傾き
=ROUNDUP(SLOPE(A1:A10,B1:B10),3)

切片と傾きは上記関数で計算できる。また、ROUNDUPは桁数の指定のために追加している。例えばこの値がA11、A12に格納されていたとすると、

="y = "&A12&"x + "&A11

とすることで近時直線を文字列にすることが出来る。

VBA

WorksheetFunctionの利用方法

WorksheetFunctionプロパティを利用することで、マクロで関数を利用することが出来る。

For i = 1 To MaxRow
std(i) = WorksheetFunction.StDev(Range(Cells(i, 1), Cells(i, MaxCol)))
Next i

選択したフォルダの絶対パスを返す

'選択したフォルダの絶対パスを返す
Function FolderName() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            FolderName = .SelectedItems(1)
        End If
    End With
End Function

この関数の戻り値にファイル名を組み合わせる場合は、最後に¥が足りないので

FolderName = .SelectedItems(1)

この部分を

FolderName = .SelectedItems(1) + "\"

こうすると便利。

選択したファイルの絶対パスを返す

上記とほぼ同様。

Function FileName() As String
    With Application.FileDialog(msoFileDialogFIlePicker)
        If .Show = True Then
            FileName = .SelectedItems(1)
        End If
    End With
End Function

フォルダ内のファイル名を取得する

'フォルダ内のファイル名を取得する
Function GetFileName(FolderName As String) As String()

    'ファイル名保存用の動的配列宣言
    Dim FileName() As String
    'Do Loop用のカウント変数
    Dim i As Long
    
    i = 0
    ReDim FileName(0)
    
    '1件目取得
    FileName(0) = Dir(FolderName & "*.csv")
    
    'ファイルが存在しない場合はメッセージを出力
    If FileName(0) = "" Then
        MsgBox "ファイルが見つかりませんでした"
    End If
    
    Do While FileName(i) <> ""
        i = i + 1
        '配列の上限を再設定
        ReDim Preserve FileName(i)
        FileName(i) = Dir()
    Loop
    
    GetFileName = FileName()
    
End Function

今回の例では.csvファイルの名前を配列として返している。呼び出し側では動的配列として返り値を受け取ればいい。

Sub Main()

    Dim test() As String
    Dim i As Long
    
    test() = GetFileName(FolderName())
    i = 0
    
    Do While test(i) <> ""
        i = i + 1
        Cells(i, 1) = test(i)
    Loop

End Sub

などとする。

アクティブなシートをThisWrokbookのシート最後尾にコピー

'シートをコピー
Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Worksheets.Count)

指定されたファイルを開く

'指定されたファイルを開く
Function OpenFile(BookPath As String)

    'オープンするワークブックの名前を保存する
    Dim BookName As String

    '指定されたファイルをオープン
    Workbooks.Open FileName:=BookPath
    BookName = ActiveWorkbook.Name
    
    OpenFile = BookName

End Function

指定されたファイルを閉じる

'指定されたファイルを閉じる
Sub CloseFile(BookName As String)

    'ファイルを閉じるときの確認を省略
    Application.DisplayAlerts = False
    Workbooks(BookName).Close SaveChanges:=False
    Application.DisplayAlerts = True
    
End Sub

ファイルを開く、閉じるはセットとして

Sub Main()
    Dim path, openbook As String
    '必要なファイルの絶対パスを保存する
    path = FileName()
    '開いたファイルのブック名を保存
    openbook = OpenFile(path)

    '処理

    Call CloseFile(openbook)
End Sub

などとすると便利。

配列による書き込みの高速化

マクロによってデータを書き込むとき、Rangeを利用して配列データを一気に書き込むほうがかなり速くなる。

Range(Cells(1, 1), Cells(10, 10)) = data

また描写をオフにすると高速化できる。

Application.ScreenUpdating = False
Application.ScreenUpdating = True

グラフ作成

'グラフ作成
Sub graph(topleft As range, datarange As range)

    With ActiveSheet.ChartObjects.Add(100, 100, 300, 350)
    
        'グラフ左上の場所を指定
        .Top = topleft.Top
        .Left = topleft.Left
        'グラフの大きさを指定
        .Width = range("C9:I30").Width
        .Height = range("C9:I30").Height
        
        With .Chart
            '折れ線グラフ
            .ChartType = xlLine
            'データ範囲
            .SetSourceData datarange, xlColumns
            '凡例なし
            .HasLegend = False
        End With
    
    End With

End Sub

Subフォルダ一覧を取得

'Subフォルダ一覧を取得
Function GetSubFolderName() As String()

    Dim strFilePath As String
    Dim strFileName As String
    Dim tmp() As String
    Dim i As Integer
    
    i = 0
    
    'カレントフォルダ格納
    strFilePath = ThisWorkbook.Path & "\"
    'フォルダ名格納
    strFileName = Dir(strFilePath, vbDirectory)
    
    Do Until strFileName = ""
        '.及び..を除外
        If GetAttr(strFilePath & strFileName) = vbDirectory Then
            If strFileName <> "." And strFileName <> ".." Then
                
                ReDim Preserve tmp(i)
                tmp(i) = strFileName
                i = i + 1
            End If
        End If
        strFileName = Dir()
    Loop
    
    GetSubFolderName = tmp()

End Function

アプリケーション定義またはオブジェクト定義のエラーです

Range内のCellプロパティがどこのブックやシートにあるか指定されていないために上記エラーが出てくることがある。

tmp = Workbooks(strFileName).Worksheets(1).Range(Workbooks(strFileName).Worksheets(1).Cells(1, 1), Workbooks(strFileName).Worksheets(1).Cells(1, 256))
ThisWorkbook.Worksheets(j + 2).Range(ThisWorkbook.Worksheets(j + 2).Cells(1, 1), ThisWorkbook.Worksheets(j + 2).Cells(1, 256)) = tmp

こんな感じでいちいち指定しなければならない。

高速化その2

http://tetsucom.blogspot.jp/2011/03/vba_9799.html
ファイル読み込みをOpenステートメント+Binaryにすると、高速で読み込みが可能となるようだ。上記を参考に、string型をDouble型にして返す関数を作ってみた。

Function FileData(ByVal File_Target As String) As Variant
'===========================================================================
'OpenステートメントのBinaryでの順次読み込み
'===========================================================================
 
    Dim intFF As Long                           'ファイル番号
    Dim byt_buf() As Byte
    Dim var_buf
    Dim str_buf  As String                      'ただの汎用変数
    Dim str_Strings() As String                 'ファイルの中身全部の文字列型配列
    Dim Row, Col As Long                            '行数カウント
    Dim i As Long
     
    Dim bytSjis As String
    Dim str_Uni As String
    
    Dim tmp, tmp2 As Variant
     
    intFF = FreeFile
    Open File_Target For Binary As #intFF
        ReDim byt_buf(LOF(intFF))
        Get #intFF, , byt_buf
    Close #intFF
     
    str_Uni = StrConv(byt_buf(), vbUnicode) 'Unicodeに変換
     
     '==============================================================
    '配列化有効時
    var_buf = Split(str_Uni, vbCrLf) '改行コードごとに区切って配列化
    Row = UBound(var_buf)            '行数取得
     '==============================================================
    
    Col = UBound(Split(var_buf(0), ","))
    ReDim tmp2(Row - 1, Col)
    
    '数値に変換
    For i = 0 To Row - 1
        tmp = Split(var_buf(i), ",")
        For j = 0 To Col
            tmp2(i, j) = CDbl(tmp(j))
        Next j
    Next i
 
    FileData = tmp2
End Function

多次元配列の大きさを調べる

http://note.phyllo.net/?eid=539332
Ubound(tmp,2)などとすると多次元配列の個数を調べることができる。詳細は上記アドレスで。

ファイル名をソート

http://oshiete.goo.ne.jp/qa/6854121.html

Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long

Sub SortByIntuitiveFilename(ByRef aFiles() As String)
    Dim i As Long
    Dim j As Long
    Dim tmp As String

    For i = LBound(aFiles) To UBound(aFiles)
        For j = i To UBound(aFiles)
            If StrCmpLogicalW(StrConv(aFiles(i), vbUnicode), StrConv(aFiles(j), vbUnicode)) > 0 Then
            tmp = aFiles(i)
            aFiles(i) = aFiles(j)
            aFiles(j) = tmp
            End If
        Next
    Next

End Sub

グラフ入力時にエラー「addメソッドが失敗しました」が出てくる

原因は分からないが、データ範囲外を選択して実行すればエラーが出ないようだ。データ範囲外を選択しれいれば問題ない?
http://www.excel.studio-kazu.jp/kw/20141013225035.html
http://muchag.undo.jp/archives/1581

ステータスバーに進行状況を表示

ググればたくさん出てくるが、メモ

starttime = Now()
Application.ScreenUpdating = True
Application.StatusBar = i + 1 & "/" & UBound(data) + 1 & " [" & Hour(Now() - starttime) & ":" & Minute(Now() - starttime) & ":" & Second(Now() - starttime) & "]"
DoEvents
Application.ScreenUpdating = False

こんな感じの記述をすれば時間と進み具合が分かる。 処理が重い場合、DoEventsを入れないと表示されないようだ。