1日3タックルを目指して頑張ります。 ロリ巨乳が大好きです。 > 今日の3タックルTopへ

Top /  Excel

Excel でテキストボックス内を検索だと!!!

 2012/09/29 (Sat) -  カテゴリ:  若干エンジニアらしい話 »  Excel

Excel のテキストボックス内の文字列を検索して、引っかかったテキストボックスの場所を探すようなことが必要になったので、がんばってみた。

面倒だったのは「テキストボックスがグループ化されているかもしれないということ」+「Shape の左上セルを返す TopLeftCell メソッドをグループ化したテキストボックスに使うと異常なセルを返してくること」の2点

せっかくコーディングしたので、とりあえずコードを貼っておく。アクティブシートに対して動くので試したい人は適当なシートにテキストボックスを追加して、B1セルに正規表現で検索条件を入れて TextBoxSearch を動かしてみてくださいな。結果は A4 のセルから下に出ます。正規表現の括弧の対応がおかしいとかそういうのはおそらくエラーになるでしょう。

Option Explicit

Public Sub TextBoxSearch()

    ' Microsoft VBScript Regular Expressions 5.5 を参照設定してね。
    Dim re As RegExp
    Set re = New RegExp

    If ActiveSheet.Range("B1") = "" Then
        MsgBox "B1のセルに検索条件を入れてください。(正規表現でマッチします)"
        Exit Sub
    End If
    re.Pattern = ActiveSheet.Range("B1")

    Dim shps As Collection
    Set shps = New Collection
    Dim targetText As String
    Dim shp As Shape
    Dim gi As Shape
    Dim resultCell As Range
    
    For Each shp In ActiveSheet.Shapes
        shps.Add shp
    Next shp
    
    ActiveSheet.Range("A4:B65536").ClearContents
    ActiveSheet.Range("A3").Value = "検索結果"
    
    Dim i As Long
    i = 1
    Do While True
        If shps.Count < i Then Exit Do
        Set shp = shps.Item(i)
        Select Case shp.Type
        Case msoTextBox
            ' テキストボックスのテキストだけ得る方法がわからんから無理やり AlternativeText
            ' から引き抜く
            targetText = Mid(shp.AlternativeText, Len("テキスト ボックス: ") + 1)
            If re.Test(targetText) Then
                'Debug.Print shp.TopLeftCell.Address グループ化されてるとおかしなことになるので使えない
                Set resultCell = ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
                resultCell.Value = targetText
                resultCell.Offset(0, 1).Value = TopLeftCell(shp).Address
                ' ハイパーリンクでも貼ってみる。
                ActiveSheet.Hyperlinks.Add Anchor:=resultCell.Offset(0, 1), Address:="", SubAddress:=ActiveSheet.Name & "!" & TopLeftCell(shp).Address
            End If
        Case msoGroup
            For Each gi In shp.GroupItems
                shps.Add gi
            Next gi
        End Select
        i = i + 1
    Loop
End Sub

Private Function TopLeftCell(shape_ As Shape) As Range
    ' グループ化すると TopLeftCell がおかしな値になるので
    ' 力技でセルの位置を特定
    Dim top As Double, left As Double
    Dim cs As Long, ce As Long, rs As Long, re As Long
    left = shape_.left
    top = shape_.top
    cs = 1
    ce = 256
    rs = 1
    re = 65536
    Do
        If ActiveSheet.Cells(1, (cs + ce) \ 2).left <= left Then
            cs = (cs + ce) \ 2
        Else
            ce = (cs + ce) \ 2
        End If
    Loop While (ce - cs) \ 2 > 0
    
    Do
        If ActiveSheet.Cells((rs + re) \ 2, 1).top <= top Then
            rs = (rs + re) \ 2
        Else
            re = (rs + re) \ 2
        End If
    Loop While (re - rs) \ 2 > 0

    Set TopLeftCell = ActiveSheet.Cells(rs, cs)
End Function

さすがは VBA だ。なんとなく書いてみれば動くもんだな。

SkyDriveにおいてみた Excel2000 で作ってるので、新しいので動くかは謎

Excel の書式 m に絶望した

 2012/07/04 (Wed) -  カテゴリ:  若干エンジニアらしい話 »  Excel

なぁおまいら Excel のセルの書式に m ってあるじゃん、「月」になったり「分」になったりする節操のないあいつ。あいつってば yyyy/mm/dd とかやると自動で月になるし、 hh:mm:ss とかやると自動で分になったりして便利だなと思ってたんだけど、単独だとゼッタイ月にしかならないって知ってた? メチャクチャ不便なんだぜ。

俺は昨日知ったよ…。自動判別しても良いけど、せめて大文字小文字で分けるとか、「mi」にしたら「分」になるくらいの機能は欲しかったなぁ。

注 : 分を表す m と mm は、h 、hh の直後、または s 、ss の直前に入力されていないと、分を表す書式記号として認識されません。分を表す m と mm を、これ以外の位置または単独で入力すると、分ではなく月の形式で表示されます。

Excel のセルの表示形式で [ユーザー定義] に使用できる書式記号について

くっそー。単独で「分」になる書式がないのはなぜなんだぜ。

Word のフィールドは、ちゃんと大文字小文字で区別できるのに…。

たとえば、{ DATE \@ "dddd, MMMM d, yyyy" } というフィールドでは、スイッチ \@ "dddd, MMMM d, yyyy" を指定しているので、"Friday, November 23, 2007" のように表示されます。日 (d)、月 (M)、年 (y) などの日付の形式と、時間 (h)、分 (m) などの時刻の形式を組み合わせて、日付/時刻の表示形式を作成します。文字列、句読点、およびスペースも指定できます。

Word でフィールド コードを挿入、書式を設定する

  l::::::::::::::::::|_!::lヽ:::::::::ハ::::::::::::::::::::::::::::::::i、::! ノ
  !:::::::::::::::::l-‐ェ!;ト ヽ:::::l ´!:::::::::::::::::::::::::::::l ` ヽ   幺ク 亡 月 |  ┼‐ .|] |]
  l:::::::::::::::::「(;;;)ヽ、__、::レ'´l:::::::::/l、:::::::::::::l   /   小巴 三l三. ヽ_ノ / こ o o
  !:::::::::/l:::l__,,,rタ"゙、;!)、__!::::/ノ 〉、::::::::l   \
   l::::/ lヽ!    _ _   l;/´  ! >、::l   /  Excel の書式 m に絶望した!!
  ノノlヽ、_!    r――‐┐   /_ノ:::|  /
    l::::::>、   レ,二二ェ!  /i:::::::::::l   ̄ ̄|_     /ヽ、  /\   /\    /
    l:::/ /::ヽ、 `ー-―-' ,ィ'::::!\:::::l    (ヽ、//\/   \/   \/   \/
    レ' ム-''´lヽ、  _,,./! ゙ヾ!__ヽ!    ヽ´ヽ、ヽ
            !   ̄     レ;'´  |  (,ゝ、 \ ヽ l、
        /| _,,.-/´  ;; .,,,-!  ヽ、 ヽ、 | | ! l
       / 斤'"〇 /´    ,;;:''" _,l_   ヽ ヽ/  l | l
      /; l、」_,,/     '' ゙;;/  ヽ、   〉  `ヽ  l/
      /!,r''´!/  /     ';,/"゙''':;,,,,;;'' \ /     ,!
    / l ,;;  |l  /`'';, ,,   /   ,;;''"゙''   l     /

進捗管理もできちゃう Excel△ (棒読み)

 2011/07/30 (Sat) -  カテゴリ:  若干エンジニアらしい話 »  Excel

ドキュメントをコツコツと書き上げる工程も終わって、やっと方眼紙 Excel からおさらばできるぜ! と思ったら、線表…だと……。Excel さん働き過ぎwwww

できれば、おまいらにはこんな不幸が訪れないことを願っているんだが、万が一不幸に見舞われたときのために、お役立ちメモを残しておくぜ

営業日の数え方

「NETWORKDAYS」ワークシート関数を使うと良い。使い方はヘルプ見れ。開始日、終了日のほかに祝日を指定できる優れもの! でも分析ツールのアドインを入れないと使えない憎いやつ。

分析ツールの入れ方は、 Excel起動→メニューバーの「ツール」→「アドイン」で開いたウィンドウから「分析ツール」をチェックして「OK」を押せばよろし

あとは、ヘルプどおりに使えば、土日祝日を除いた営業日を返してくれる。遅延日数なんかを計算するのに地味に便利

線の引き方

タスクはオートシェープの四角形で引くのが好きなので、その方法

オートシェープで四角形を描くには↓な感じでOK、更に Left, Top には Range オブジェクトのそれを指定できる。

ワークシートオブジェクト.Shapes.AddShape(msoShapeRectangle, 左座標, 上座標, 幅, 高さ)

サンプルコードはこんな感じ

Sub DrawTasks()
    
    Dim b As Workbook
    Dim ws As Worksheet
    Dim target As Range
    Dim task As Shape
    
    Set b = ThisWorkbook
    Set ws = ThisWorkbook.Sheets(1)
    Set target = ws.Range("A1:C1")
    With target
        ' コレで A1 ~ C1 にぴったりサイズの四角形が書ける。
        Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height)
        task.Fill.ForeColor.SchemeColor = 41
    End With

    Set target = ws.Range("A2:C2")
    With target
        ' 細くするときはこんな感じ 1/3 の高さの線が真ん中に引ける。
        Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top + .Height / 3, .Width, .Height / 3)
        task.Fill.ForeColor.SchemeColor = 42
    End With

    Set target = ws.Range("A3:C3")
    With target
        ' 予定
        Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top + .Height / 6, .Width, .Height / 3)
        task.Fill.ForeColor.SchemeColor = 43
        ' 実績
        Set task = ws.Shapes.AddShape(msoShapeRectangle, .Left, .Top + .Height / 2, .Width, .Height / 3)
        task.Fill.ForeColor.SchemeColor = 44
        ' みたいなこともできる
    End With
    
End Sub

このサンプルだと、実行するたびにオートシェープがガンガン重なっていくので、オートシェイプを書く前に削除しないといけないんだけど、削除はかなり厄介。何も考えずに Shapes をぐるぐる回して全部消しちゃうと、メモで残しておいたテキストボックスとかそういうのも全部消えちゃって、切ないことになるし。

とりあえず個人的に現時点で最善だとおもうやり方は、対象のセルを上から For Each でまわして、一行の範囲に納まっている Shape を削除するという方法。これだと、セルを複数行にまたいでいる Shape は消えないからほとんどの場合、期待通りに動きそう。更に Shape の Type が msoShapeRectangle のときだけ消すとか、その辺のチェックを入れておけばほぼ大丈夫かなと思ったり。

2011/12/26 追記 その後、良いやり方を発見した。オートシェープを追加したタイミングで、適当な名前(例えば「予定_行番号」)を付けておいて、次回は、「予定_」という名前で始まるオートシェープを削除すれば、ある程度狙ったオートシェープだけ消せるはず。

良く考えたら Excel で線表引いてる時点で最善もクソもないんだけどなwww

というワケで削除のサンプル

Sub DeleteTasks()

    Dim b As Workbook
    Dim ws As Worksheet
    Dim target As Range
    Dim s As Shape
    Dim r As Range
    
    Set b = ThisWorkbook
    Set ws = ThisWorkbook.Sheets(1)
    Set target = ws.Range("A1:A10")

    
    For Each s In ws.Shapes
        If s.Type = msoShapeRectangle Then
            ' 消す テキストボックスは消えないけど、四角形とか楕円なんかはきえちゃう
            's.Delete
        End If
    Next s

    For Each r In target
        For Each s In ws.Shapes
            ' 1行目から10行目の行をまたいでいない shape が全部消える。
            ' 上の Type の判定と合わせて使っても良さそうだけど、ちょこっと使うツール
            ' としてはこっちだけで十分 ただ、線表が大きくなるとループ回数が気になる。
            If s.Top > r.Top And (s.Top + s.Height) < (r.Top + r.Height) Then
                s.Delete
            End If
        Next s
    Next r

End Sub

とまぁこの辺を組み合わせれば線表は引ける。あとはリソースの重なりをチェックしたり、稲妻線を出したり、進捗管理をするためには、まだまだ色々必要そうだな。ちなみに、我が家では Excel2000 が現役なんで、サンプルは Excel2000 のサンプルな。

<input type='file' /> + IE8 難攻不落杉ワロタ

 2011/01/15 (Sat) -  カテゴリ:  若干エンジニアらしい話 »  Excel

Excel VBA で IE を動かすというむなしい努力をしているところだが、なんかだんだん楽しくなってきたぜー。と思った矢先にやっぱり何かが起こるのが俺の人生だよなぁ。

なぁオマイラ IE8 だと type 属性が file の input 要素の値はファイル選択ダイアログからしか変更できないって知ってた? 俺知らなかったよ。おかげで結構無駄な努力をしちゃったよ。

歴史的に見て、HTML の ファイル アップロード コントロール (input type=file) はかなりの数の公開された脆弱性の温床であり続けました。この問題を解決するため、このコントロールの動作について二つの変更を加えました。

ユーザーの入力するローカルのファイル パスをキーストロークの監視によって盗む攻撃を防ぐため、ファイル パスの編集ボックスを読み取り専用としました。ファイルをアップロードする場合、ファイルの参照ダイアログを利用して、ファイルを指定する必要があります。

http://msdn.microsoft.com/ja-jp/ie/dd218483.aspx より

というワケで、本気を出してセキュリティホールをつぶしにかかった MS に喧嘩を売っても勝てそうにないのであっさり IE7 に逃げましたとさ。まぁ IE7 でもブラウザをアクティブにする → ファイルパスの文字列をクリップボードに送る → くだんの input を選択 → Application.SendKeys "^v" (Ctrl + V ね) というなんとも酷い方法しかできなかったんだけどさぁ(まぁそこは適当なツールなんで妥協しとく)。

個人的なメモとしてのリンク

http://msdn.microsoft.com/ja-jp/library/ms531073.aspx ← document Object のリファレンス ここを見たら getElementByID とか、document Object が使える GetElement[s] 系のメソッドが載ってるんだぜ。なんだよ getElementsByClassName 使えるじゃんと思ったら IE9 か…。

久々に VBA の話題

 2010/07/07 (Wed) -  カテゴリ:  若干エンジニアらしい話 »  Excel

Excel VBA で任意のシート名のシートが存在するかを確認する方法

Excel の VBA で、あるシート名のシートが存在するかを確認するとき、今までは 無駄ループを回すか On Error で凌いでたけど、色々考えてたら名案が浮かんだのでメモしとく。

今まではこんな感じ

Sub test()
    Dim s As Worksheet
    
    ' 無駄ループパターン
    For Each s In ThisWorkbook.Worksheets
        If s.Name = "Sheet1" Then
            MsgBox "Sheet1 は存在する"
            ' break
        End If
    Next s

    ' On Error パターン
    On Error Resume Next
    Set s = ThisWorkbook.Worksheets("hogehoge")
    On Error GoTo 0
    If s Is Nothing Then
        MsgBox "hogehoge は存在しない"
    End If
End Sub

これからのワークシート存在チェックはコレ!

Sub test()
    ' 素晴らしいことにたった一行でチェックできる。
	' WorkSheets(1) は必ず存在するはず。
    MsgBox ThisWorkbook.Worksheets(1).Evaluate("ISERR(Sheet1!A1)")
    MsgBox ThisWorkbook.Worksheets(1).Evaluate("ISERR(DummySheet!A1)")
End Sub

Evaluate で ISERR ワークシート関数を無理やり呼び出して、調べたいシート名の A1 セルを参照させた結果がエラーになるかどうかを調べてるだけ。シートが存在すれば False が返ってくる。

ちょっとしょぼいけど、無駄ループや On Error Resume Next を使うよりはマシかな。

ちゃんとヘルプにも書いてあるんだな。

 2010/02/28 (Sun) -  カテゴリ:  若干エンジニアらしい話 »  Excel

おい、おまいら Excel の Round って使ってる? 特にはまったりしたワケじゃないけど、この歳にして真実を知ったので書いておく。「Roundはワークシート関数だと四捨五入されて、VBAで使うと偶数まるめとやらになるらしい (Excel2003)」

実際にはほとんど同じような動きをするんだけど、微妙に動きが違うので初心者は気をつけろ! 以下、イミディエイトウィンドウで実行してみた結果

?Round(1.04, 1)
 1 
?Round(1.05, 1)
 1 
?Round(1.06, 1)
 1.1 
?Application.Round(1.04, 1)
 1 
?Application.Round(1.05, 1)
 1.1 
?Application.Round(1.06, 1)
 1.1 

という感じになるので VBA で Round を使うときに明確に四捨五入したい場合は Application をつけろってこった。

VBA めんどくせー

 2010/01/28 (Thu) -  カテゴリ:  若干エンジニアらしい話 »  Excel

本気出しても結局終電になるのは変わらんな。

VBA にやられた件

Excel2003 + xlsm ファイルで

Debug.Print Mybook.Sheets("hogehoge").Range("A1")

的な処理を処理を動かしたら死んだ。Excel2003 + xls なら動くのに…。

Dim hoge As WorkSheet
set hoge = Mybook.Sheets("hogehoge")
Debug.Print hoge.Range("A1").Value

なら良いらしい。2007 + xlsm だったらどうなるのかな?

たまにメモでも書いてみる

 2009/09/19 (Sat) -  カテゴリ:  若干エンジニアらしい話 »  Excel

なかなか忙しい一週間だった。忙しすぎて久々に寝坊したぜ。

メモ

最近テストデータ作りに勤しんでたんで、今後のためにメモしとく

Excelの日付とか時間のシリアル値をUNIXタイムに変換する式(ちょっとずれてるかも)

Excel 2003 は確認した

(excel の時間 - 25569) × 86400

PythonでUNIXタイムとか

import time
>>> # 2009/09/19 12:34:56 後ろの 3 個は多分 0 で埋めとけば大丈夫
>>> time.mktime([2009, 9, 19, 12, 34, 56, 0, 0, 0])
1253331296.0
>>> # ローカル日時
>>> time.localtime(1253286000.0)
(2009, 9, 19, 0, 0, 0, 5, 262, 0)
>>> # 世界標準時にしたければこっち
>>> time.gmtime(1253286000.0)
(2009, 9, 18, 15, 0, 0, 4, 261, 0)

日付とか時間とかをプログラムで扱うのはメンドクサイね。

ポスグレ

タブ区切りテキストを投入する

COPY テーブル名 FROM 'データファイル名' WITH NULL AS 'NULL として扱いたい文字列'

テーブルのデータをタブ区切りテキストに出力する

COPY テーブル名 TO 'データファイル名' WITH NULL AS 'NULL として扱いたい文字列'

標準入力から受け取りたい場合は 'データファイル名' のところを stdin にする。標準出力に出したいときは stdout にする。

まだまだあった気もするけど忘れた。過去に書いた自分のメモを検索しようとして職場で 3タックルを開くのがはばかられるのはナゼなんだぜ。

君はエスパークスを知っているか。

 2009/09/03 (Thu) -  カテゴリ:  若干エンジニアらしい話 »  Excel

オートフィルタの上限

なぁおまいら、オートフィルタのリストに表示される項目数って 1000件が上限だって知ってた? 俺は今日初めて知ったぜ

オートフィルタの各フィールドの矢印ボタンをクリックして表示されるリストに、すべてのデータが表示されない場合があります。これは表示可能なデータ数に制限があるためです。Excel の各バージョンにおける制限は以下のとおりです。

Excel 97 / 2000 / 2002
リストの入力データのうち、重複しないものが 1000 件目まで表示されます

[XL2002]オートフィルタのドロップダウンリストに表示可能なデータ数 より

ちなみに Excel2007 は 10000件まで表示できるっぽい。 Excel 2007 におけるパフォーマンスの改善

エスパークス

あれだけ一世を風靡したのに、職場では知らないやつ多すぎワロタ マジでおまいらどんな青春時代を送ったんだぜ。

というか、 >>500 氏がエスパークスを知らない言い訳に言い出した関東限定説はないわー とりあえず「エスパークス」という文具は全国で発売されたのでしょうか。の結果を待とう。

エスパークス:オフィシャルサイト

ムーンヲーク

みんなで練習しよう。そして会社にムーンヲーク部を設立するんだ。

最近はツールを作るのがちょっとメンドクサイ

 2009/08/21 (Fri) -  カテゴリ:  若干エンジニアらしい話 »  Excel

VBAが便利

今後のためにメモ

VBA から ADODB.Connection で PostgreSQL に接続するときの接続文字列はこれ

"DRIVER={PostgreSQL Unicode};DATABASE=データベース名;SERVER=サーバのIPアドレス;PORT=ポート;UID=DBユーザ;PWD=パスワード;"

つなぎかた

Dim cxn As ADODB.Connection
Set cnx = CreateObject("ADODB.Connection")
cnx.open "接続文字列"

SQLの実行はこんな感じ

Dim rs As ADODB.Recordset
set rs = cnx.Execute("SQL文")

' 取得した行を最後までループしたい場合
' rs が Nothing のときは無限ループになるから気をつけろ!
Do While Not rs.EOF
    Debug.Print rs.Fields("カラム名")
    rs.MoveNext
Loop

ちなみにMicrosoft Activex Data Objects X.X Library の参照設定をしたり PostgreSQL ODBC Driver をクライアントにインストールしたりする必要があるよ。

 | トップへ |  次ページへ »
最新記事
カテゴリ
最新コメント
最新トラックバック
月別アーカイブ
カウンタ
_

カレンダー
04 | 2017/05 | 06
- 1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31 - - -
これはやべぇ

インターネッツの設定をしてあげたついでに、接続確認と称してこのブログを開いたら、気になるあの娘が検索したアイテムがwww

万が一アダルトグッズが表示されたりしたらと思うと股間が熱くなるな。

とか妄想してたけど、インターネッツの設定をしてあげた直後に検索の履歴が残ってるわけないか
(´・ω・`)
にしても使い方によってはこの機能は凶悪だな。

プロフィール

タックル

Author:タックル
三度のメシより大ライスが好きなエンジニアです。
焼肉屋に行ったら最初の一杯は大ライスで乾杯! 全然関係ないけど食堂のカレーなら4杯は軽いよ。

ちなみにロリ巨乳は大ライスより好き!

プライベートでタックルされてくれるロリ巨乳のお友達を24時間365日募集中です。

エントリーの内容はタックルの日々の生活について多少脚色しながら面白おかしく書いている限りなくノンフィクションに近いフィクションです。

嘘を嘘と見抜けない人は(ry

Webサービス
フィードメーター - 今日の3タックル あわせて読みたいブログパーツ
タックル会
個人的なリンク