DuKiccoの雑記

My Life Is Myself

【グラフにラベルを付ける】【エクセル,VBA,グラフ】

折れ線グラフが複数ある場合、凡例を普通に配置しても、似たような色の線が必ず存在するので系列名とどの折れ線が対応するかわかりにくいです。

例えば以下のグラフは1920年~2000年の県別の人口推移ですが何が何だかわかりません。

f:id:DuKicco:20190923183640p:plain
県別人口推移

見やすくするためによく使われる方法としては、終点にラベルを表示して系列名を表示します。またラベルの色は折れ線に合わせて変更し、重ならないようにずらします。以下の通り。手作業でやろうとすると大変なので、VBAで自動化してみました。

f:id:DuKicco:20190923184140p:plain
県別人口推移

コードを実行するまでの流れは以下の通りです。

1.適当に折れ線グラフを作る(グラフ→散布図→直線)
2.グラフをアクティブ(選択)にする。
3.コードを実行する。(アクティブチャートに対して処理します。)

Rank関数は以下を参考に。
dukicco.hatenadiary.jp

Sub グラフに色付きで系列名のラベルをはる()

Dim i As Long, j As Long, k As Long, l As Long, m As Long, arr As Variant, arr1 As Variant, tst As String
Dim tsingle1 As Single
    
    'まずはチャートを選択しておく
    
    '系列名を表示するスペースを確保
    'プロットエリア(内)の幅を取得
    tsig = ActiveChart.PlotArea.Width
    'グラフエリア(外)の幅を設定。内側+200
    tst = ActiveChart.Parent.Name
    ActiveSheet.Shapes(tst).Width = tsig + 250
    ActiveChart.PlotArea.Width = tsig

   '各系列の最終データの数値を取得し配列に格納
    ReDim arr1(1 To ActiveChart.SeriesCollection.Count)
    For i = 1 To ActiveChart.SeriesCollection.Count
        arr = ActiveChart.SeriesCollection(i).Values
        arr1(i) = arr(UBound(arr))
    Next
    
    '各系列をループ
    For i = 1 To ActiveChart.SeriesCollection.Count
        'ActiveChart.SeriesCollection(i).Select
        arr = ActiveChart.SeriesCollection(i).Values
            
            '各系列のデータ数を取得。一番最後のデータにラベルを表示する。kを1にすると一番左のデータにラベルされる。
            k = UBound(arr)
            ActiveChart.SeriesCollection(i).Points(k).ApplyDataLabels
            '各系列の系列名を取得
            tst = ActiveChart.SeriesCollection(i).Name
            On Error Resume Next
            'ラベルの表示を値から系列名に変更
            ActiveChart.SeriesCollection(i).DataLabels(k).Format.TextFrame2.TextRange.InsertAfter tst
            'ラベルの位置を取得
            tsingle1 = ActiveChart.SeriesCollection(i).DataLabels(k).Left
            '系列の最終データの値の順位を取得。
            m = Rank関数降順(arr1, i)
            'ラベルを順位に応じずらしていく。上から5つずらしたら元の位置に戻す。
            ActiveChart.SeriesCollection(i).DataLabels(k).Left = ((m - 1) Mod 5) * 40 + tsingle1
            '系列折れ線のカラープロパティを取得
            j = ActiveChart.SeriesCollection(i).Format.Line.ForeColor.RGB
            '系列名の文字数を取得
            l = Len(tst)
            'ラベルの色を折れ線の色に変更。フォントサイズを10。太字。
            ActiveChart.SeriesCollection(i).DataLabels(k).Format.TextFrame2.TextRange.Characters(1, l).Font.Fill.ForeColor.RGB = j
            ActiveChart.SeriesCollection(i).DataLabels(k).Format.TextFrame2.TextRange.Characters(1, l).Font.Size = 10
            ActiveChart.SeriesCollection(i).DataLabels(k).Format.TextFrame2.TextRange.Characters(1, l).Font.Bold = msoTrue
    Next

End Sub
Function Rank関数降順(arr As Variant, j As Long) As Long
'渡された配列内の順位を返します。
Dim i As Long

For i = 1 To UBound(arr)
    If arr(j) = WorksheetFunction.Large(arr, i) Then
        Rank関数降順 = i
        Exit For
    End If
Next

End Function

【配列内の順位を取得する/ソートする。】【エクセル,VBA】

VBAでは配列内の数値の順位を取得したり、並べ替えたりといった関数が存在しませんので自作してみました。

Worksheet.FunctionのLARGE関数やSMALL関数を使用するとシンプルなコードで実現できます。ちなみに順位の取得にはRANK関数が使用できるともっともシンプルなのですがこちらの関数は配列を引数にできないために使えません。LARGE関数は降順、SMALL関数は昇順の順番を出すために使用します。

Function Rank関数降順(arr As Variant, j As Long) As Long
'arrは順位比較したい配列。jは順位を知りたい要素番号。降順。
Dim i As Long

For i = 1 To UBound(arr)
    '降順1位から順にループしていき値が同一であったら順位を確定。
    If arr(j) = WorksheetFunction.Large(arr, i) Then
        Rank関数降順 = i
        Exit For
    End If
Next

End Function
Function Rank関数昇順(arr As Variant, j As Long) As Long
'arrは順位比較したい配列。jは順位を知りたい要素番号。昇順。
Dim i As Long

For i = 1 To UBound(arr)
    '昇順1位から順にループしていき値が同一であったら順位を確定。
    If arr(j) = WorksheetFunction.Small(arr, i) Then
        Rank関数昇順 = i
        Exit For
    End If
Next

End Function
Function ソート降順(arr As Variant) As Variant()
'arrはソートしたい配列。
Dim i As Long, arr1() As Variant

ReDim arr1(1 To UBound(arr)) As Variant

For i = 1 To UBound(arr)
 '昇順1位から順にループしていき配列を格納していく。
    arr1(i) = WorksheetFunction.Large(arr, i)
    
Next

ソート降順 = arr1

End Function

Sub test1()
'動作確認
Dim arr(1 To 5) As Variant, arr1 As Variant, i As Long

arr(1) = 10
arr(2) = 2
arr(3) = 100
arr(4) = 11
arr(5) = 20

'Rankの結果確認
MsgBox Rank関数降順(arr, 1)
MsgBox Rank関数昇順(arr, 2)

'ソート降順の結果確認
arr1 = ソート降順(arr)

For i = 1 To 5
    Debug.Print arr1(i)
Next
End Sub

【配列内の順位を取得する/ソートする。】【エクセル,VBA】

VBAでは配列内の数値の順位を取得したり、並べ替えたりといった関数が存在しませんので自作してみました。

Worksheet.FunctionのLARGE関数やSMALL関数を使用するとシンプルなコードで実現できます。ちなみに順位の取得にはRANK関数が使用できるともっともシンプルなのですがこちらの関数は配列を引数にできないために使えません。LARGE関数は降順、SMALL関数は昇順の順番を出すために使用します。

Function Rank関数降順(arr As Variant, j As Long) As Long
'arrは順位比較したい配列。jは順位を知りたい要素番号。降順。
Dim i As Long

For i = 1 To UBound(arr)
    '降順1位から順にループしていき値が同一であったら順位を確定。
    If arr(j) = WorksheetFunction.Large(arr, i) Then
        Rank関数降順 = i
        Exit For
    End If
Next

End Function
Function Rank関数昇順(arr As Variant, j As Long) As Long
'arrは順位比較したい配列。jは順位を知りたい要素番号。昇順。
Dim i As Long

For i = 1 To UBound(arr)
    '昇順1位から順にループしていき値が同一であったら順位を確定。
    If arr(j) = WorksheetFunction.Small(arr, i) Then
        Rank関数昇順 = i
        Exit For
    End If
Next

End Function
Function ソート降順(arr As Variant) As Variant()
'arrはソートしたい配列。
Dim i As Long, arr1() As Variant

ReDim arr1(1 To UBound(arr)) As Variant

For i = 1 To UBound(arr)
 '昇順1位から順にループしていき配列を格納していく。
    arr1(i) = WorksheetFunction.Large(arr, i)
    
Next

ソート降順 = arr1

End Function

Sub test1()
'動作確認
Dim arr(1 To 5) As Variant, arr1 As Variant, i As Long

arr(1) = 10
arr(2) = 2
arr(3) = 100
arr(4) = 11
arr(5) = 20

'Rankの結果確認
MsgBox Rank関数降順(arr, 1)
MsgBox Rank関数昇順(arr, 2)

'ソート降順の結果確認
arr1 = ソート降順(arr)

For i = 1 To 5
    Debug.Print arr1(i)
Next
End Sub

【HTMLカラーコードをエクセルで使う】【エクセル,VBA,16進法,RGB】

エクセルでグラフを作成する際など、デフォルトの配色ではいまいちなことが多いです。きれいな色を探す際に他の配色サイトを参考にすることがありますが、そこではHTMLカラーコード(HEX)で記載されているケースが多く、エクセルではそのままでは利用できません。あまり詳しく書かれているサイトがないので、以下に HTMLカラーコードをエクセルで使用するまでをまとめます。

配色サイト例

www.webdesignrankings.com

 

coolors.co
coolors.co

 

まずは基本知識としてカラーコードとRGBについて理解しましょう。

カラーコードとは、Webページ上で表現される色を指定するための制御コードのことである。

カラーコードはシャープ(#)に続く6桁の16進数で表記される。2桁ごとに赤・青・緑の濃淡が表され、16進数(0~F)の0が最も薄く、Fに近づくほど濃い色となる。例えば白は「#FFFFFF」、黒は「#000000」、オリーブ色は「#808000」である。

woma2.com

 
以降エクセル内でのお話に移ります。

エクセルでセルの色を取得すると例えば「5177573」といった整数値が返ってきます。これは何かといいますと16進法の6文字の文字列が数値に変換されたものになります。注意が必要な点としては先のサイトにありましたように一般的には16進法表記ではRGBの順になるのですが、VBAでは仕様上「BGR」逆の順番になっていることです。

 
ですので元のカラーコードが「0123ef」だったとするとエクセルでは二文字単位で順番を逆さにして「ef2301」と入れ替える必要があります。VBA中ではこの文字列に16進法文字列を意味する&Hを足して、これをcLngで数値型に変換し、カラープロパティ値として指定してあげればよいのです。

 
例えばRange("A1")を赤「カラーコード→#FF0000 」く塗るコードは以下の通りです。

Range("A1").Interior.Color = CLng("&H0000FF")

以下にカラーコードからカラープロパティ値を取得する関数と使用例を示します。

GetColor はRGB→BGRに入れ替え16進法文字列から整数値に変換していますが、他の方法としてGetColor 2のように、二文字ずつとりだして、数値に変換して(例FF→256。これもVBA中ではclng("&HFF")みたいなかんじでいけます。)、RGB関数に代入する方法もあります。テストコードで出てくるメッセージは両方の関数で変換された数値になりますが同じ数字が出てくることを確認できると思います。

Function GetColor(tst As String) As Long
'カラーコードから対応するカラープロパティ値を出力
'tst→#が取り除かれたカラーコード6文字

GetColor = CLng("&H" & Mid(tst, 5, 2) & Mid(tst, 3, 2) & Mid(tst, 1, 2))

End Function
Function GetColor2(tst As String) As Long
'カラーコードから対応するカラープロパティ値を出力
'tst→#が取り除かれたカラーコード6文字

GetColor2 = Rng(CLng("&H" & Mid(tst, 1, 2)), CLng("&H" & Mid(tst, 3, 2)), CLng("&H" & Mid(tst, 5, 2)))

End Function
Sub test()
'Range("A1:B1")を赤(FF0000)に、Range("A2:B2")を黄色(FFFF00)に塗る。
    Range("A1").Interior.Color = GetColor("FF0000")
    MsgBox GetColor("FF0000")
    Range("A2").Interior.Color = GetColor("FFFF00")
    Range("B1").Interior.Color = GetColor("FF0000")
    MsgBox GetColor("FF0000")
    Range("B2").Interior.Color = GetColor("FFFF00")
End Sub

格安シムからWimaxへ乗り換え

月3000円程度で満足のいくネット環境が得られました。

 

経緯

この春から一人暮らし(@千葉県西部)をはじめて、携帯(Docomo)+ポケットWifi(格安シム、Freetel)の組み合わせでネット環境で過ごしていた。Freetelは従量制(20GB天井設定)なのでネットを使わない月は安かったのだが、最近アマゾンプライムで動画を見るようになってから20GB程度使用し5000円程度かかるようになってきた。また、携帯をいくつか持っていてアップデートでかなり通信量を要する月があった。Freetelの実効速度が遅い(動画再生時にしばしば凍る)割に20GBだと安く感じなかったため、ネット環境について再検討を行った。

 

要望事項

家で→3000円くらいで、高速動画再生。できれば使い放題。常に10bps以上。

外で→出張+外回り多い。できればポケットWifiに繋いで携帯の通信量をさげたい。携帯はSIM端末なので、携帯会社の縛りが切れた時点で、格安MVNOに移行したい。

 

検討内容

まずは格安シムで無制限プランを検討したが、最大速度と実効速度に大きく差があるとのことで手を出さないほうが無難そう(実効速度は場所と時間による)。かといえ数十GBのプランにすると高価だが実効速度について保証はない。また、振り返って考えてみると、優良なサービスを長期的に継続して提供してくれる格安SIM会社があるのだろうかという疑問もあり(優良→加入者増加→速度低下)。格安シムではなくWimaxを採用。

 

WimaxのプロバイダーはいくつかあるがSonetを採用。

 メリット

・キャッシュバックはないが月々の利用料金が安い(キャンペーンで月2500円、初期費用なし)

・2年縛り

・価格を抑えるためハイスピードエリアプラスモードには入らず(電波の弱いエリアではLTEに切り替えるサービス。つまりはauと同じエリア、同じ速度。ただしこのモードは通信量7GBまで。)。

 

Wimaxにしての感想

よかったこと

・高速で無制限(@我が家。千葉県西部)

 

少し気になること

・ビルの中、田舎に行くと電波が届かないことがある。新幹線に乗って観察すると携帯の電波に比べエリアが狭いことがよくわかる。

→ほとんど関係ないのだが出張で行くこともあるので、少し困るケースがあり。プラス1000円でハイスピードエリアプラスモードに入れば問題なし。

Diginnos Stick DG-STK3(スティック型PC)

スティック型PCを購入しました。HDMI出力になってるのでリビングや出張先のテレビで簡単にネットや動画が観れるのでとても便利です。キーボード、マウス込みでたったの12000円です。

 

背景

我が家の母艦はMacですがエクセルも使うのでMacの仮想環境でWindowsを走らせてました。ただしMacのアップグレードに伴い仮想環境への追加投資も必要になるので安いWindowsが欲しいなと思ってました。僕としてはネットが観れてエクセルができれば十分でした。

 

機種選定

とにかく安くということで以下の製品にしました。加えて、キーボード、マウス、モニター(TVでもOK)が必要です。OSはWindows10が入ってますがOfficeは入ってませんキーボード、マウス込みでたったの12000円です。安い。

Diginnos Stick DG-STK3

www.dospara.co.jp

 

周辺機器との接続用にUSBポートが二つあります。

 

使用感

エクセルやネットは全くストレスなく動きます。リビングの大きなTVで見るのも気持ちいいものでした。余計なソフトが全く入っていないのも個人的には好印象です。

弱点は冷却機能が弱いことです。動画は再生できなくはないですが、負荷がかかると発熱し性能が落ち、さらに発熱する悪循環に陥ります。ただ↓にあるような安いUSBファンで風をあてると発熱は抑えられます。また、余計な負荷をかけないためバックグラウンドでの自動更新はなしにして従量課金モードにするとよいと思います。

 

www.nishishi.com

 

僕はアマゾンプライムに入っているのですが出張先の空き時間で見たかったプライムビデオを消化できることがうれしいオマケでよい買い物でした。

 

スマートリモコン化

経緯

めざまし時計に耐性がついてしまい、冬は寒くて暗くて、なかなか布団から出れません。対策として、照明とエアコンをタイマーでコントロールして朝にONにしたいと思いスマートリモコンを入れてみました。大したことをやりたいわけではないので、「とりあえず安く」がコンセプトです。安くできたら「子供のエアコン付けっ放し問題」対策として、2台目を入れたいと思ってます。

 

概要

iPhone→アプリ(Intelligent Homo Center)→本製品(RM mini3)→家電(エアコン、照明)という流れでリモートコントロールやタイマー制御が可能になりました。とても満足です。

 

機種選定

Amazonで調べたところ以下の製品が最安でした(2018/2/10時点。3,600円)。また、いろいろ懸念点はありますが、中国のサイトだとさらに半額で買えそうとのことでこちらを選びました。

 

Broadlink Wifi 赤外線 学習 リモコン RM mini3 

 

問題は、設定やアプリの入手に労力が必要なことです。調べ物やセッティングで一時間くらいかかりました。AmazonにはDIY用と書かれてます。Do it yourself !

 

大まかな手順

USのAppStoreにアカウントを作り、本製品のアプリを入手(事前にここまでやれることを確認しておいた方がよい。。)

本製品をAmazonで購入

本製品をiPhone(アプリ)と家のWifiに接続

本製品に家電リモコンを学習させる

iPhone(アプリ)で家電をコントロール

 

詳細説明

・USのAppStoreにアカウントを作り、本製品のアプリを入手

実は本製品の日本仕様は2倍の価格で売っています。日本で入手できるアプリだと並行輸入品は繋げません。ですのでAmazonではラズパイ経由で使用する製品と記載されています。

 

 

USのAppStoreにアカウントを作りアプリを入手する方法はこちらのサイトを参考にしました。

https://nipponomia.com/how-to-buy-us-appstore/

クレジットカードの登録なしに作れます。住所は適当に登録しますが、こちらのサイトでダミーの住所を教えてもらうと楽チンです。

ja.fakenamegenerator.com

 

 

アプリ(Intelligent Homo Center)を入手。本製品を初期設定するためにはiPhoneの言語設定を英語にしてアプリを開かないと上手くいかないようです(各種設定後は日本語に変更可能)。

 

・本製品をAmazonで購入

とくにつまずきポイントはありませんが、本製品は他の製品と同様、多くの家電で使われている赤外線リモコンにのみ対応してます。RFリモコンに対応させたい場合は注意が必要です。

 

・本製品をiPhoneと家のWifiに接続

本製品を電源(USB)につないでアプリを立ち上げます。そうすると機器接続の画面がありますのでそこでWifiを選択し、パスワードを入れます。僕はスムーズにできたのですが、ここでつまずきポイントがいくつかあるようです(SSIDにアンダーバーを入れてはいけないとか、暗号化の方式だとかetc)。以下の日本仕様の製品の取説リンクが役に立ちます。付属の取説は中国語です。

eRemote | Link Japan

 

・アプリを開き本製品を登録

バイスお追加してくのですが、ここも少しわかりにくいです。

バイスカテゴリーから追加→全カテゴリ(リモコン)→RM3です。

iPhoneが日本語設定だと日本仕様の製品しか選べなくなります。

 

・本製品に家電リモコンを学習させる

ここでも日本仕様の製品の取説が役に立ちます。難しくはありません。

 

僕の場合はスムーズにできたので楽しかったのですが、ハマると大変そうだなという印象です。次は増設とGoogle Homeへの接続にチャレンジしたいと思ってます。