fc2ブログ
プログラミング覚え書き TOP  > 

ブログを引っ越しました

ブログを引っ越しました.

今までありがとうございました.
今後ともよろしくお願いします.

新しいブログ
スポンサーサイト



[ 2021年10月11日 17:03 ] カテゴリ:未分類 | TB(0) | CM(0)

単語の抽出

私は OKWAVEを良く利用する(質問も回答も).
最近あった質問に単語を抽出したいというものがあった.
日本語の場合,それだけで学問の一分野ができるほど深遠なもので素人が手を出せるものではない.
ただ,文字コードの抽出だけであれば,素人でも何とかなりそうなので,文字を判定するコードを作成してみた.
Private Functionで作成しているのは,ワークシート上で 1文字だけを判定するという使い方は無いだろうとの想定である(需要があれば Public Functionに設定して下さい).

まずは,文字が英語のアルファベットかどうかを判定するコード.
全角文字も判定できるように StrConvで半角に変換してから判定している.
アルファベット以外の文字をアルファベットとして認識したい場合を想定して,追加したい文字をオプションで指定できるようにしてみた(後述する関数も同じ仕様).

' --- ここから
Private Function isAlph(ByVal strChar As String, Optional ByVal strAdd As String) As Boolean
    strChar = StrConv(strChar, vbNarrow)
    isAlph = strChar Like "[a-zA-Z]" Or InStr(strAdd, strChar) > 0
End Function
' ここまで

英語の場合,合成語を "-" で接続する場合があるので,strAddに "-" を指定すれば "-" もアルファベットとして認識できる.

次に,カタカナを判定するコード.
カタカナの場合は,半角・全角があるのと,"ヽ" と "ヾ" をカタカナ扱いする必要がある.
"スズキ" を "スヾキ" と表記したり "ススキ" を "スヽキ" と表記することがあるから.

' --- ここから
Private Function isKatakana(ByVal strChar As String, Optional ByVal strAdd As String) As Boolean
    ' ヽヾ の 2文字はカタカナとする
    strAdd = "ヽヾ" & strAdd
    strChar = StrConv(strChar, vbNarrow)
    isKatakana = strChar Like "[ヲ-゚]" Or InStr(strAdd, strChar) > 0
End Function
' --- ここまで

ここでも,全角文字も判定できるように StrConvで半角に変換してから判定している.

次に,ひらがなを判別するコード.
ひらがなに半角はないが "ゝ" と "ゞ" をひらがな扱いする必要がある.
"いすず" を "いすゞ" と表記するのは,有名過ぎるだろう.

' --- ここから
Private Function isHiragana(ByVal strChar As String, Optional ByVal strAdd As String) As Boolean
    ' ゝゞ の 2文字はひらがなとする
    strAdd = "ゝゞ" & strAdd
    isHiragana = strChar Like "[ぁ-ん]" Or InStr(strAdd, strChar) > 0
End Function
' --- ここまで

最後に,漢字を判別するコード.
ここで問題なのは「漢字とは何ぞや」である.
漢字を使う国は世界的には少数ではあるが,各国によって使う漢字が異なる.
日本の場合,コンピュータの世界では JISコードによって定められている.
なので,ここでは JISコードで定められている文字の中から,日常生活で漢字として扱われている文字を判別することとし "〃仝々〆〇ヵヶ" の 7文字も漢字と判定することにした.
"ヵヶ" については異論もあるとは思うが,日本語の表記として "ヵヶ" の前に数字もしくは漢字が付き,単独で発音することがないということで漢字扱いにすることにした(異論があれば適当に修正して使用して下さい).

' --- ここから
Private Function isJisKanji(ByVal strChar As String, Optional ByVal strAdd As String) As Boolean
    ' 〃仝々〆〇ヵヶ の 7文字は漢字とする
    strAdd = "〃仝々〆〇ヵヶ" & strAdd
    isJisKanji = strChar Like "[亜-熙纊-黑]" Or InStr(strAdd, strChar) > 0
End Function
' --- ここまで

これらの Private Functionを使って実際に使える Public Functionの例を以下に示す.

この例では strSrcに指定された文字列について,ひらがなとカタカナ以外を半角スペースに置換している.つまり,文字列からひらがなとカタカナ(半角・全角)だけを抽出し,半角スペースで区切っている.
区切り文字は Delimiterで指定できるようにしたので,使用者が "," や chr(10)を指定するなど適当に指定して欲しい(指定が無ければ,半角スペース).

' --- ここから
Public Function PicChar(ByVal strSrc As String, Optional ByVal Delimiter As String = " ") As String
    Dim i As Long
    Dim strChar As String

    ' ひらがな・カタカナ以外を半角スペースに置換
    For i = 1 To Len(strSrc)
        strChar = Mid(strSrc, i, 1)
        If Not isKatakana(strChar) And Not isHiragana(strChar) Then
            Mid(strSrc, i, 1) = " "
        End If
    Next

    ' 不要なスペースを削除
    strSrc = WorksheetFunction.Trim(strSrc)

    ' 半角スペースをデリミタに置換
    strSrc = WorksheetFunction.Substitute(strSrc, " ", Delimiter)

    ' 結果を関数に返す
    PicChar = strSrc
End Function
' --- ここまで

追記:
ブログ引っ越しました.
新しいブログ
https://masnoske.com/prog/

[ 2020年11月29日 16:55 ] カテゴリ:未分類 | TB(0) | CM(0)

Excelの日付計算のバグについて

Excelの日付計算を調べていて気になったことがある.
Excelの日付の起点が 1900/1/1であることは,多くの人が知っていると思う.
そこで 1900年のカレンダーを作ってみたところ,なんと 1900/2/29が出現したのだ.
「1900年って 4で割れるから閏年だよね」と考えるのは早計である.
グレゴリオ歴における閏年のルールは以下の通り.
  1. 西暦年が4で割り切れる年は(原則として)閏年.
  2. ただし、西暦年が100で割り切れる年は(原則として)平年.
  3. ただし、西暦年が400で割り切れる年は必ず閏年.
つまり,1900年は 2.のルールによって平年なのだ.

これは Microsoftのバグではないかと調べて見たところ,意外な事実が見つかった.
Excelが広まる以前,世界を席巻していた表計算ソフトは,ロータス社の Lotus 1-2-3であったが,このソフトで 1900年を閏年として扱っていたのである.
後発の Excelとしては互換性を保つため,1900年を閏年として扱ったというのが問題の本質のようである.
Excelで 1900/1/1~1900/3/1を扱うような場合は注意が必要だ.
Excelの日付の起点が 1900/1/1であることは事実.
しかし 1900/1/1から何日目かを計算するような場合は,1900/3/1以降については 1900/2/29の分だけ 1日多くなっていることに注意が必要だ.

追記:
ブログ引っ越しました.
新しいブログ
https://masnoske.com/prog/
[ 2020年09月20日 10:27 ] カテゴリ:未分類 | TB(0) | CM(0)

WorkbookDeactivate の罠

別ブックのイベントを補足するマクロで嵌まった。
以下のコードを ThisWorkBook に記述。

' --- ここからソース
Private WithEvents XlApp As Application
Private Sub Workbook_Open()
    Set XlApp = Application
End Sub
Private Sub XlApp_WorkbookDeactivate(ByVal Wb As Workbook)
    MsgBox Wb.Name
End Sub
' --- ここまでソース

開いているブックが非アクティブになったときにイベントが発生するのだが、パラメータの Wb は、非アクティブになった後にアクティブになったブックなので油断ならない。

追記:
ブログ引っ越しました.
新しいブログ
https://masnoske.com/prog/

[ 2019年03月07日 20:20 ] カテゴリ:VBA | TB(0) | CM(0)

動的に変化するボタン

リボンを触っていると、その時の状況に応じてボタンの On/Off など、動的に変更したい場合がある。
customUI14.xml の内容は以下のとおり。

<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="OnLoad">
  <!-- ここからがリボンの内容 -->
  <ribbon>
    <tabs>
      <tab id="Tab0" label="MyTab">
        <group id="Grp1" label="マイグループ">
          <button id="Btn1" size="large" getLabel="GetLabel" getImage="GetImage" onAction="OnAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
  <!-- ここまでがリボンの内容 -->
</customUI>

各プロパティの内容は以下の通り。プロパティ名には大文字・小文字の区別があるので要注意。
onLoad="プロシージャ名"
  リボンがロードされる時に呼び出される。
  リボンコントロールを捉えられる唯一のプロシージャ。
getLabel="プロシージャ名"
  コントロールのラベルを動的に設定する。
getImage="プロシージャ名"
  コントロールの画像を動的に設定する。

それぞれ呼び出されるプロシージャは、標準モジュールに定義する。
標準モジュールの内容は以下の通り。

' --- ここからソース
Private rbRibbon As IRibbonUI
Private IsHappy As Boolean

' リボンをロードした時にコールされるプロシージャ
' リボンオブジェクトを補足できる唯一のタイミング
Private Sub OnLoad(ribbon As IRibbonUI)
  ' rbRibbon にリボンオブジェクトを代入する
  Set rbRibbon = ribbon
    
  ' control をリボンコントロールとして定義する
  Dim control As IRibbonControl
    
  IsHappy = True
  rbRibbon.Invalidate ' リボンを更新する
End Sub

' ボタンの画像を設定
Private Sub GetImage(control As IRibbonControl, ByRef returnedVal)
  Select Case control.ID
  Case "Btn1"
    If IsHappy Then
      returnedVal = "HappyFace"
    Else
      returnedVal = "SadFace"
    End If
  Case "Btn2"
    ' customUI14.xml に id="Btn2" を定義している場合は、ここで処理する
  End Select
End Sub

' ボタンのラベルを設定
Private Sub GetLabel(control As IRibbonControl, ByRef returnedVal)
  Select Case control.ID
  Case "Btn1"
    If IsHappy Then
      returnedVal = "Change Sad"
    Else
      returnedVal = "Change Happy"
    End If
  Case "Btn2"
    ' customUI14.xml に id="Btn2" を定義している場合は、ここで処理する
  End Select
End Sub

' ボタンをクリックした時のアクション
Private Sub OnAction(control As IRibbonControl)
  Select Case control.ID
  Case "Btn1"
    IsHappy = Not IsHappy
    rbRibbon.Invalidate ' リボンを更新する
  Case "Btn2"
    ' customUI14.xml に id="Btn2" を定義している場合は、ここで処理する
  End Select
End Sub
' --- ここまでソース

追記:
ブログ引っ越しました.
新しいブログ
https://masnoske.com/prog/
[ 2018年10月23日 22:14 ] カテゴリ:リボン | TB(0) | CM(0)
訪問者数
プロフィール

masnoske

Author:masnoske
プログラミングの覚え書きです。
主な言語は VBA と WSH(VBS) です。

最新コメント
最新トラックバック
アクセスランキング
[ジャンルランキング]
コンピュータ
3150位
アクセスランキングを見る>>

[サブジャンルランキング]
プログラミング
617位
アクセスランキングを見る>>
検索フォーム
ブログランキング
にほんブログ村 IT技術ブログ VBAへ

ブロとも申請フォーム
QRコード
QR