【Excel】繰り返しセルの値を更新する時のパフォーマンスアップ

こんにちは。部隊長です。
秋ですが飽きもせずExcelネタ。色々寒風寒々しくなってまいりました。

まず、Excelでセルに値を入れる時、ループで1セルずつ処理すると大変遅うございます。

こんなの。100行×100列処理

        
dim r as range, i as long, j as long
set r = thisworkbook.workshees("sheet1").range("a1")
for i = 0 to 100
  for j = 0 to 100
    range.offset(i,j).value = hoge
  next
next

処理時間は1秒弱でしょうか？ ScreenUpdating = False　を使えばほぼ気にならないですが、 実際のプログラムだとこのループの間に計算式や他のセル参照などが入っていたりしてどんどん重くなってしまっていると思います。

そこで・・・

値を予め二次元配列に入れて、同じ大きさのRANGEに貼り付けるととても速いのです。

こんな感じ

        
dim r as range, i as long, j as long
dim ary(100,100) as variant
set r = thisworkbook.workshees("sheet1").range("a1")
for i = 0 to 100
  for j = 0 to 100
    ary(i,j) = hoge
  next
next

r.resize(i+1,j+1) = ary

マクロが遅くてお困りの方、お試しください！

[Excel]簡単相関分析とt検定

こんにちは！残暑厳しいですが如何お過ごしですか？
自転車通勤してたら焼けすぎで遊びすぎに思われている部隊長です。
子供より黒いです。まずい。

また最近学術的な方面のお仕事をやらせて頂いているので、
復習も兼ねてExcelで相関分析とその検定方法について書いてみます。

[相関分析とは]
2つの要素に関連性があるのかどうかを調べます。
関連性とは、ある要素xが増えた時に、別の要素yも同じように増える傾向がある、とか。

[t検定とは]
2つの要素の関連性だけでは、標本数が少ない場合などに偶然関連性が強く出てしまうことや
逆に弱く出てしまう事があります。
そこで、2つの要素の平均値に統計的に明らかな差があるかどうかを調べることで、その相関関係も統計的に意味があると言える。のだそうです。たぶん。

[どんな時につかうの]
まず、2つの要素が数値の時。（ある、なしなどの選択肢や、1-2-3位などの順位では、別のやり方をします）
例えば・・・暑い夏にうまい冷えたビールを飲んだ量と、でた(?)量が相関するかどうか・・・

経験上相関しますけど。


1.　データを準備！

2.　プロットして相関関係を表示

(1)データエリアを選択して、挿入→散布図　
(2)レイアウト→近似曲線→線形近似曲線
(3)近似曲線を右クリック→近似曲線のオプション→グラフにR-2乗値を表示する
とすると、下のようなグラフが出来上がります。

※その他、式を表示したり好みでマーカーの色を変えたりしてます。

先ほど表示にチェックしたR-2乗値。これが2つのデータ間における、相関関係を表す値となります。

1に近づく程相関関係が強いですので、かなり強力に相関していますね。

やっぱり飲んだら出るんです。

3.　t検定の実施（=TTEST(データ1,データ2,片側/両側,検定の種類)）

空いているセルに「=TTEST(」と打ち込んで、第一引数に「のんだ」データ
第二引数に「でた」データを選択。
第三引数は、今回平均値の差が多くても少なくても関係無いので「両側分布」の2を選択。
第四引数は、等分散を検定していないのでWELCHの検定（非当分散を仮定）である3を選択。

・
・
・
すると、関数の結果としてp値が計算されます。
・
・
・

結果は0.000477（0.0477%）で、危険率1%未満です。
飲んだビールの量とでた(?)量には統計上有意差があり、関係が無いことが棄却され
やっぱり飲んだら出る(?)ことが証明されました！



※この実験結果はフィクションです。実際に測った(?)わけではありません！


サンプルファイルをコピー


記事とは全く関係ないですが、弊社は来月9/10より下記所在地へ移転致します。
移転後も変わらぬご愛顧、ご指導ご鞭撻を賜りますよう、社員一同お願い申しあげます。

【新事務所住所】
〒104-0032
東京都中央区八丁堀2丁目1-7白鳳ビル2階
TEL：03-5542-0642
FAX：03-5542-0643




大きな地図で見る

.NET カスタムコントロールの日付型初期値

こんばんは。部隊長です。 暑すぎてエアコン全開にしても32度しか下がりません。ECOです
本日もまたハマってしまったシリーズです。


環境はVB.NET NULLを許容するDataTimePickerを参考に、未入力が可能な日付コントロールを作成しているのですが、 
未入力時の初期値が何故か"2012/2/8"になっている事象が発覚（ずっとモヤモヤしていたのだがウヤムヤにして逃げｔ）

しかし初期値をもつプロパティを用意していて、Enter時に_isnullならMyBase.Valueを置き換えるようにしているのにも関わらず、まったく置き換わらない。なぜだ。
ソリューションの.Designer.vbファイルを見てみると・・・

        Me.cdtp_DateOpen.DefVal = New Date(2012, 2, 8, 0, 0, 0, 0)

これか・・・

作戦1。

    Public Property DefVal As Date = DateTime.Today

ﾀﾞﾒ・・・

作戦2

    Public Sub New()

        ' この呼び出しはデザイナーで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後で初期化を追加します。
        Me.DefVal = DateTime.Today　'<-これ
        
        AddHandler Me.Enter, AddressOf setDefaultValue

    End Sub

またﾀﾞﾒ・・・くそう

作戦3

    Protected Overrides Sub InitLayout()
        MyBase.InitLayout()
        Me.DefVal = DateTime.Today　'<-これ
    End Sub

ﾀﾞﾒ・・・なんでー！

ここで、プロパティのDefaultValueAttributeを思い出す。 ・

・

・

・

・

…orz



長くなったので結果からいくとコレでいけました

　　<categoryattribute("data")> _
    <defaultvalue("")> _
    Public Property DefVal As Date

日付型にキャストできないから当日日付になった・・・？


単に技術力の低さを露呈する記事にしかなっていないのはｷﾆｼﾅｲ


また！

【Excel】シートをFax送信するアドイン絶賛公開中！

ダウンロードはこちらから！

※Excel→PDF変換に「BullZipPDFPrinter」というフリーウェアを使用しています。

2011 年 10 月以降に公開された Excel 2007 の更新プログラムを適用すると表示通りに印刷できない

2011 年 10 月以降に公開された Excel 2007 の更新プログラムを適用すると表示通りに印刷できない



な、なんだってーーー！！！（AA略



今晩は。無隊長です。

表題の件、今年3月のMSサポートなのですが、これは困った。

なんでって医療関係者の方々から大絶賛されているMNA®スターターキットExcel版に影響するじゃないか。



今のところ当事象に関する修正パッチはまだリリースされておらず、
回避方法は該当のアップデートを削除する、との事です。

Hotfixは出てまして、弊社Excel2007環境では正常動作を確認しておりますが、
一般ユーザー様へはあまりお勧めできません。
（ちゃんとテストされてないから解決するかどうかわからないし余計ぶっ壊れるかもよと脅し文句が書いてあるものなので）

MSからの修正パッチを待ちましょう・・・

【.NET】WindowsFormをドラッグした時に半透明にする

こんにちは！部長です。
最近お仕事の引き合いを多く頂いております。ありがたやありがたや(´人｀)
新年度に入り心機一転、がんばりましょう。弊社の決算は9月ですので新下半期ですが。

スクラッチの業務APって色気無いですよね。殺風景というか。
弊社のクライアント様で、デザイン性に非常にこだわっておられるところがあるのですが、
そのお陰で社内プロダクトにもいろいろと見た目にも気にするようになってきました。

その一環で、某パッケージAPで、ドラッグされているウィンドゥが半透明になっているものがあり、
弊社製品にもﾊﾟｸ実装してみました。

こんな感じ

    ''ドラッグ中に半透明
    Private Const WM_MOVING As Integer = &H216
    Private Const WM_EXITSIZEMOVE As Integer = &H232
    Protected Overrides Sub WndProc(ByRef m As Message)

        Try
            If m.Msg = WM_MOVING Then
                Me.Opacity = 0.8
            ElseIf m.Msg = WM_EXITSIZEMOVE Then
                Me.Opacity = 1.0
            End If
            MyBase.WndProc(m)
        Catch ex As Exception
            throw
        End Try
    End Sub

ボタンダウンとアップのタイミングでやったらなんかうまくいかなかったのでWM_MOVINGとWM_EXITSIZEMOVEで
今のところ正常動作中。。。

【.NET】ColorオブジェクトをSQLServerに保存する

随分と間が開いてしまいました。BS部隊長です。
これからはちょっと頑張ってPOSTしようと思います今日この頃。

最近は.NETによるクライアントAPの案件が多いのですが、
そこでユーザーごとにテーマカラーを保存して、表示する時に背景やら前景やら色変えたり変えなかったりしたらいいよねというアイデアがありまして、

至極単純な話なのですが、あれ？どうやるんだ？と暫く悩んだのでネタにしてみます。
あ、保存先はSQLServerです。2008R2。2012弄りたい。



で、どうやろうかと悩んで出した案


案1．Colo.Nameを文字情報で持つ（FromNameメソッドで復元）
->ブレンドした色は持てない
案2．XMLに書きだして保存
->めんどくさい
案3．intの配列に変換してvarcharで保存
->めんど（ｒｙ


結果から言ってしまうとColor.ToARGBというメソッドが既に準備されててintegerに変換して保存します。超簡単。時間返せ。

コード
**修正**２０１２・０３・２４（ToARGB使ってなかった・・・orz）　

private _color as integer
''' 

    ''' 色ボタンクリ
    ''' 
    ''' ''' ''' 
    Private Sub cbt_Color_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cbt_Color.Click
        If Me.ColorDialog1.ShowDialog() = DialogResult.OK Then
            _color = Me.ColorDialog1.Color.ToARGB
            Call setGradation(Me.cbt_Color, _color, _color)
        End If
    End Sub

    ''' 

    ''' ボタン内色■変えるよ
    ''' 
    ''' ''' ''' ''' ''' 
    Private Sub setGradation(ByRef btn As ccButton, ByVal fcol As Integer, ByVal tcol As Integer, Optional ByVal direction As Drawing2D.LinearGradientMode = Drawing2D.LinearGradientMode.ForwardDiagonal)
        Dim bmp As Bitmap = New Bitmap(btn.Width, btn.Height)
        Dim g As Graphics = Graphics.FromImage(bmp)
        Dim gradBrush As New Drawing2D.LinearGradientBrush( _
            g.VisibleClipBounds, _
            Color.FromARGB(fcol), _
            Color.FromARGB(tcol), _
            direction)
        g.FillRectangle(gradBrush, g.VisibleClipBounds)
        gradBrush.Dispose()
        g.Dispose()
        btn.Image = bmp
        btn.Refresh()
    End Sub

Enjoy！

高齢者の栄養スクリーニングツールMNAガイドブック 発売中です

高齢者に適した栄養スクリーニングツールであるMNA(Mini Nutritional Assessment)の本格的な書籍
「高齢者の栄養スクリーニングツールMNAガイドブック」が医歯薬出版社様より発売されました！

当社が開発・サポートを行なっております「MNA スターターキット」のCD-ROMが付属しています。
是非お試しください！
（利用にはExcel2000～2010のいずれかが必要です。Windows版のみ。）




MNA®て何？
6項目からなる栄養状態を把握するシートです。（ショートフォームの場合。）
詳しくはネスレ日本株式会社　ネスレニュートリションカンパニー様のWEBサイトをご参照下さい。

※医療従事者、関係者向けのサイトなので、詳細なページへの直接リンクはご容赦下さいm(__)m

Excelを用いたシステムのご相談、ツール開発、その他諸々、ご相談下さい！(∩´∀｀)∩

Excel2010ってば・・・shapeがずれる！

Excel2010だと、他のバージョンに比べてShapeが右にずれる！

なので、Excel2010の場合、Shapeを左に3ポイントずらして描画することで対応するけど、
なんだか納得いかねぇ～なぁ～。

Excel2007だと印刷される罫線がExcel2010だと印刷されないんだよね。

まさか、Windows7の仕業（プリンタドライバ）じゃなかろう・・・・な・・・そこまで変わるか！？
ぬぬぬ・・・

印刷時にExcel2010の罫線が歯抜けになる現象

Excel2010の場合、印刷時に罫線が歯抜けになる事象が発生。
なんだよ・・・勘弁してくれよ・・・・

当然、2003と2007は正常に出力されるんだよね。
色の指定とかも疑ったのだが、試してみても印刷されない。
ほんと、頼むよぉ～、Excel。

で、ネットを漁っていたらヘッダーフッターの印刷が無ければ？OKだそうな。

今回は、フッターに画像を入れて印刷していたのだが、それをはずしてみた。
すると・・・・
罫線が印刷できたよ・・・
ほんと、勘弁してくれよなぁ・・・
なぁ～に、この仕様・・・
仕方ないので、フッターは使わずに画像を貼り付けることにするわ。

[Excel]シートを別ブックに保存する

こんちは。部隊長です。
梅雨でジメジメの蒸し暑暑ですが元気に行きましょう。寒いより暑いほうが好きです。女子は薄着になるし。

今回もまたExcelVBAで芸がないのですが、30分考えたので書き起こします。

そもそもあるシートを新規ブックとして起動させるには、

Dim sht as WorkSheet
Set sht = ThisWorkbook.Worksheets("対象のシート")
sht.Copy

これだけ。
対象シートが非表示の場合、Copyメソッドが失敗しますので、
ブックの保護解除とシートの可視化も導入

Dim sht as WorkSheet
Set sht = ThisWorkbook.Worksheets("対象のシート")
ThisWorkbook.Unprotect Password:=BKPWD
sht.Visible = True
sht.Copy
sht.Visible = False
ThisWorkbook.Protect Password:=BKPWD

この新規ブックを別名で保存するには、CopyするとWorkBooksがAddされたのと同じ状態になりますので、

'' 最後のブックを別名で保存
Workbooks(Workbooks.Count).SaveAs newFileNm, FileFormat:=xlNormal

します。ActiveWorkBookでもいいですが、Copyの後にActiveが動くような事があると・・・

というわけで全体のコードはこんな感じ。CSV形式での保存も対応しています。

Sub SaveAsOtherName

 Dim newName As String
 newName = _
     Application.GetSaveAsFilename( _
          InitialFileName:="デフォのファイル名" _
        , FileFilter:="エクセルファイル(*.xls),*.xls" & _
         ",CSVファイル(*.csv),*.csv" _
        , FilterIndex:=1 _
        , Title:="保存先の指定" _
        )

 If newName = "FALSE" Then Exit Sub
 If Dir(newName) <> "" Then
     If MsgBox("同名のファイルが存在します。上書きしてもよろしいですか？", Title:=MSGBOX_TITLE, Buttons:=vbYesNo) <> vbYes Then
         Exit Sub
     End If
 End If

 Dim sht As Worksheet: Set sht = ThisWorkbook.Worksheets("コピー対象シート名")

 ThisWorkbook.Unprotect Password:=BKPWD
 sht.Visible = True
 sht.Copy
 sht.Visible = False
 ThisWorkbook.Protect Password:=BKPWD

 Application.DisplayAlerts = False

 '' 新ファイル名称の拡張子で保存形式を判定しています。
 If CheckExtension("xls", newName) Then
     Workbooks(Workbooks.Count).SaveAs newName, FileFormat:=xlNormal
 Else
     Workbooks(Workbooks.Count).SaveAs newName, FileFormat:=xlCSV
 End If

 ActiveWorkbook.Close

 Application.DisplayAlerts = True

 MsgBox "保存しました", Title:=MSGBOX_TITLE
 
End Sub

divirta-se!