もし建て直すとしたら、百万円ぐらいは軽く掛かるから簡単には済まないので、損害賠償で犯人を捕まえたいぐらいだよ － バス停上屋（栄区・横浜市）

立ち入り禁止のコーンが置いてあった

早朝の五時ごろでしたか、戸外でガシャーンとどでかい音がして驚きました。
つんざくような金属音で、目覚める前の浅い眠りだから、叩き起こされたんだ。

でも、眠気だけは未だ残っていて、ウトウトしながらも少し時間が経ちました。
やがて、程なく寝入ってしまいましたが、それだけ衝撃音が大きかった分けよ。

それで、その結果は冒頭の写真で、バス停の上屋（ルーフ）が傾いていました。
何かが支柱の根元にぶち当たって大きへし折られ、屋根の傾きが不安定なんだ。

このバス停はマンションの前にあって通勤に便利そうですが、自分は関係ない。
だって、徒歩で通勤しているし、最寄りのＪＲ駅までは歩ける範囲の距離です。

なので、バス停の利用する頻度が少なく関心が薄かったのですが、今回は違う。
写真を見てもらうと分かりますが、自動車が反対車線から突進したかのようだ。

   
しかも、縁石を乗り上げてぶち当たっているところを見ると、かなりの速度か。
路面には、タイヤの擦ったブレーキ痕が全く見られず、余裕もなかったのかな。

となると、すぐそばの交差点を猛スピードで左折し、車線に戻れなかったのか。
恐らくハンドル操作を誤って、上屋の柱に突撃した印象がぬぐい切れないんだ。

自動車なのか大型バイクなのか、なぜかというと支柱に油がこびりついている。
要するに、ぶち当たってエンジンが破壊されてオイルが漏れだしたような感じ。

車両は、すぐに引き出されたみたいですが、地面におが屑がまかれていました。
茶色い顆粒状で吸着剤だと気が付いて、あたりを見回すと路面もうっすら黒い。

だいぶ油が流出したんだと思いますが、運転した人は怪我しなかったのかなあ。
へし曲がった支柱には、赤い塗料辺までこびりついていて、赤い車体なのかな。

   
最近でも、二つ先のバス停上屋が何かに衝突されて、基礎がグラつきました。
この結果、建て替えが必要になりましたが、同じバス路線で二か所も破壊だよ。

このバス路線の県道は、壊されたバス停の間が、カーブのある上り下りの坂道。
峠道みたいになっていて、夜間だと爆音を鳴らす暴走族も駆け抜けて行きます。

横浜市内の道路にしては、交通信号機の間隔も長いし、スピード出せるんだよ。
だから、速度違反のネズミ捕りで臨検も行われたりして歩行者は気を付けよう。

というわけで、この交差点の近辺は、交通事故がよくあるので危険なんだよな。
自分なんか、横断歩道で青信号になって渡ろとしたら、左折車が歩行者を確認もせずにスピードを出して曲がって通り過ぎていくような物騒なご時世ですから、人身事故でなくて物損事故程度なら、これ幸いと思わずにはいられないのでした。

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村 

配列が空かどうかを調べるのに、自作の関数を実装するなんて、わざと凝ったつ くりで自己満足するだけよ － VBA・Split関数（そのほか）

Split関数ならぬ、スプリット変化球の握り

前回の投稿では、セル内で改行されたデータを置換するのに工夫してみました。
コードの動きも繰り返しで実験して、Split関数の吐き出す配列で確認したのよ。

コード的には、置換の文言とループ関数で取得したセル値の文言を比較します。
ただ、何もデータのない空白セルだけは、Ｉｆ構文で特定することにしました。

Dim Cll As Range
For Each Cll in Selection
If Cll.Value = "" Then GoTo EndTsk
～そうでない時に、配列が合うか比較するコード～
End Tsk
Next Cll

そのロジック部分を抜き出すと上の通りですが、詳細は前の投稿を参考下さい。
GoToステートメントを使って、条件外になると次のステップを飛ばす算段です。

本当は、Split関数で条件の配列と比較する配列が、完全に比較できると思った。
ところが、ターゲットのセル値が空白だと配列が比較できずに置換してしまう。

実験用のシートが、一面で置き換わってしまって、これはいかんと思いました。
なのでセル値が空であれば、シンプルに無駄な作業をスキップさせてみました。

コードの動きを何度か実証してみましたけれど、実用範囲だからＯＫでしょう。
ただ、空白セルでSplit関数がどのような結果を吐き出すのか、よく分からない。

ネットで調べてみましたが、配列が空なのかどうかを調べる関数はないらしい。
変数が配列なのかを調べる関数（IsArray）はありますが、配列を作った結果だ。

だから、この関数による結果が、空の配列であっても結果的には"True”になる。
ならば、空の配列なら値が無いと思い、IsEmpty関数で確認しても結果が違う。

Split関数は、配列の要素順番が、LBbound（開始値）UBound（最終値）です。
でも、IsEmptyにぶち込んでも、”False”とでるので空とは認識していなさそう。

    Dim tmp As Variant
    tmp = Split(Cells(1, 1), Chr(10))　’空白セル・区切り文字は改行コード
    If IsEmpty(LBound(tmp)) = "True" Then MsgBox "True"
    If IsEmpty(LBound(tmp)) = "False" Then MsgBox "False"

となれば、Split関数は区切文字が見つからなくても　配列はでっち上げるんだ。
これが分かっただけでも御の字で、ネットを当たると自作関数を紹介するほど。

Functionプロシージャを設定する説明だったけど、もっと簡単じゃないのか。
そう思って、どんな開始と最終の値を出力するか、しつこく調べてみたんだよ。

Dim tmp As Variant
tmp = Split(Cells(1, 1), ”※”)　’区切り文字は”※”
If UBound(tmp) = -1 And LBound(tmp) = 0 Then MsgBox "空のセル"
If UBound(tmp) = 0 And LBound(tmp) = 0 Then MsgBox "区切文字無し"
If Len(Cells(1, 1)) > 0 And InStr(Cells(1, 1), ”※”) = 1 Then MsgBox "先頭が区切文字"
If Len(Cells(1, 1)) > 1 And Len(Cells(1, 1)) = InStrRev(Cells(1, 1), ”※”) Then MsgBox "末尾が区切文字"

　　
シートの先頭セルに、メッセージボックスにある条件で入力してみてください。
一番目のＩｆ文は空白セルの場合、二つ目はデータに区切文字が見当たらない。

三番目は、末尾が区切文字で、四番目は、先頭が区切り文字になるという事例。
まあ、三番目と四番目は、区切文字が入っているセルなので配列には違いない。

このため、字数を調べて区切り文字が先頭か末尾かを条件式で判断しています。
まあ、四つの条件を満たすセルの内容は、作業をスキップしまえばいいんだ。

つまり、この関数は区切文字でデータを仕切ることしか想定していないような。
というわけで、区切る位置がイレギュラーな場合を想定しない関数なのでした。

実際、この関数を使うとしたら、区切り文字で要素に配分してから、必要な配列順番のデータを取得して、次の作業ステップに移行しますが、先頭に区切り文字が出るようなケースは、データの羅列として考えられそうもなく、ありえるのはデータ末尾に区切り文字が入ってしまうことぐらいでして、そういう事例はプログラミングの工夫で操作も出来そうだと思ったのでした。

おまけ：
とてもイレギュラーだけど、セルの値が複数の区切り文字だけだとしたら、、、
　　　
Dim i As Long
Dim tmp As Variant
　　　
i = 0
tmp = Split(Cells(1, 1), "※")
　　　
Do While i < UBound(tmp) + 1
If Not tmp(i) = "" Then GoTo WithData
i = i + 1
Loop
　　　
MsgBox "要素が空"
GoTo Finish
　　　
WithData: MsgBox "要素が存在"
Finish:
　　　
End Sub
　　　

　　　
コメント：結果は、”要素が空”と表示。一個でも文字が挟まっていると存在。

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村 

エクセルのシートで、改行された文字データのセルを上手に置換できるVBAのプログラムを書いたのでござる － ＶＢＡマクロ（そのほか）

　　
最近、社内で使われるプロトコルのマニュアルを、英語に翻訳して疲れました。
プロトコルは通信制御手段とも言われますが、分かったようで分からない言葉。

仮に身近にある道具を使って説明するなら、USBでデータのやり取りでしょう。
USBメモリーを、パソコンに指してデータを移動させるのは、当たり前なんだ。

それで、ソケットを見ると四つの接続端子しかなくて、しかも二つは電源供給。
となると、データ通信はたったの線二本でしか行われていないことになります。

そうなると、この二本でデータを上手く受け流すには、制御ルールが必要なの。
これが通信制御手段で、英語で格好良くプロトコルって言うだけの話なのです。

ユニバーサル・シリアル・バスは頭文字からUSBなんだけど、通信規格の一つ。
コンピュータの内外から、各回路がデータ交換で共通の経路を使うのに必要だ。

コンピュータ用語ですが、有線だろうが無線の５Gだろうが通信は規格が重要。
このコミュニケーションのしきたりがちゃんとできないと、機械は村八分状態。

勤務する会社が扱う製品も、サーバーと通信できなければ、ただのハコ扱いよ。
だから、システム開発をする上で、きちんとプロトコルを理解してもらいます。

お客さんに提供するマニュアルも揃えますが、海外の顧客が出始めてきました。
このため、是が非にでも英語化する必要に迫られたのか、支援を頼まれました。

　　　　
それで、上記のようなマニュアルに訳しましたが、技術用語の繰り返しが多い。
エクセルで作られているので”置換”の操作もできますが、一つ困りごとが発生。

それは、一つのセルの中でAlt+Enterキーで改行したフレーズを書いた時です。
これって、画面上では改行コードが見えないのですが、Chr(10)が含まれます。

そんな時、置換コマンドでも出来るんですが、検索に貼る文字画面が一行だけ。
入力しながらCtrl+Ｊキーを押すと改行できるけど、文字が見えなくなりました。

特にカナや漢字へ変換が必要な時に、隠れた字句が変換できたのか分からない。
ならば、該当する字句にセルを当てて、置換を呼び出して改行するとします。

やってみたんだけど、改行が二つ以上になると、かなりやりづらいんだよなあ。
つまり、セル内で改行してある文言が素早く置換できたら迅速に仕上がるんだ。

　　　　
なら、VBAでプログラムを作ってみるしかないと思って、挑戦してみましたよ。
何とかできましたが、プログラミングのミソは、配列のアイデアを活用した点。

セル内の、改行コードのChr(10)で区切られる字句を要素の配列に見立てます。
この配列内容が、指定した範囲内で各セルの内容と合致しているか確認します。

もし合致していれば、置換で指定した字区を、該当セルに書き込んで行きます。
そして、置換で指定された字句は一行から四行までに対応するようにしました。

まあ、コードの特長では、ループ処理と条件分岐式（複数）を活用した分けよ。
ループ処理のFor～Nextに、For Each～Nextを使い、他には条件分岐（複数）。

Select Caseですが、置換の字句も改行コードから要素の配列に分解しています。
それから、この要素数で判断し、改行コードを含む字句に再構成して書き込む。

このため、置換されたセルは、元の字句が三行でも、置換で四行にもできます。
まあ、セル一つで改行コードで四行以上にする人もいないと思って止めました。

というわけで、画面を操作するイベントプロシージャまで組み込んでみました。
他に開いたブックのシート画面から、置換したいセルをコピーしておき、貼り付けるセルをダブルクリックしてデータのみを張り付けるアイデアで、書式までコピペしてしまうのを防いでいるのですが、この他、セルを置換する対象になるブックと、このプログラムのブック以上にブックが開かれていると、置換が実行されないなど、それなりに実用性を意識して作ったのでした。
　　　
★参考までにコード記述：
※ThisWorkbookのコーディング
Private Sub Workbook_Open()

    With Application
        .WindowState = xlNormal   '標準
        .Width = 200
        .Height = 200
    End With
 
'枠線を残す・消す
    ActiveWindow.DisplayGridlines = False 'True
'行列番号を残す・消す
    ActiveWindow.DisplayHeadings = False 'True
'シート見出しの表示 / 非表示
    ActiveWindow.DisplayWorkbookTabs = False 'True
'スクロールバーを残す・消す
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
 
Cells(3, 2).Value = ""
Cells(3, 4).Value = ""
ActiveCell = Cells(1, 1)
Worksheets(1).Activate

End Sub
-------------------------------------------------------------------------
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal

Target As Range, Cancel As Boolean)
    On Error Resume Next
    If Not Target.Value = "" Then GoTo EndTsk
    If Target.Value = "" Then Target.PasteSpecial xlPasteValues
    Application.CutCopyMode = True
EndTsk:

End Sub
--------------------------------------------------------------------------
※モジュール1のコーディング
Sub Button1_Click()

 Dim Orgnl As Variant
 Dim Trgt As Variant
 Dim Rvsd As Variant
 Dim Cll As Range
 Dim i As Long
 Dim tmp As String

 For i = 1 To Workbooks.Count
  If Workbooks.Count > 2 Then GoTo Finish
  If Not ActiveWorkbook.Name = Workbooks(i).Name Then tmp =

Workbooks(i).Name
 Next i

Orgnl = Split(ActiveSheet.Cells(3, 2).Value, Chr(10))
Rvsd = Split(ActiveSheet.Cells(3, 4).Value, Chr(10))

Workbooks(tmp).Activate

For Each Cll In Range("A1:AQ1000")

If Cll.Value = "" Then GoTo TskEnd

Trgt = Split(Cll.Value, Chr(10))

If Not UBound(Orgnl) = UBound(Trgt) Then GoTo TskEnd

For i = 0 To UBound(Trgt)
If Not Orgnl(i) = Trgt(i) Then GoTo TskEnd
Next i

Select Case UBound(Rvsd)
Case 0
Cll.Value = Rvsd(0)
Case 1
Cll.Value = Rvsd(0) & Chr(10) & Rvsd(1)
Case 2
Cll.Value = Rvsd(0) & Chr(10) & Rvsd(1) & Chr(10) & Rvsd(2)
Case 3
Cll.Value = Rvsd(0) & Chr(10) & Rvsd(1) & Chr(10) & Rvsd(2) & Chr(10) &

Rvsd(3)
End Select

TskEnd:

Next Cll

Finish:

ThisWorkbook.Activate
Cells(3, 2).Value = ""
Cells(3, 4).Value = ""

End Sub

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村