Excelマクロのメモ
「月/日」なデータをExcelシートに入力したら勝手に「今年/月/日」になって困ったことはありませんか。私はあります。
一つ2つなら手で治すんですが3000件位あるデータの中のあちこちにそういうのがあって一つ一つ潰してくのが嫌だったのでマクロ書いてました。
多分数年後にまた使うと思うので日記に残しておきます。
Option Explicit ' 選択範囲にある日付の年だけを指定した年に変更する Sub changeYear() Dim rw, cl, dt, cy, rng, dstr If TypeName(Selection) = "Range" Then Set rng = Selection cy = InputBox("変更したい年を指定してください", "年だけ変更", Year(Date)) If IsNumeric(cy) = False Then Exit Sub If CInt(cy) < 1900 Then Exit Sub For rw = 1 To rng.Rows.Count For cl = 1 To rng.Columns.Count dt = rng.Cells(rw, cl).Value If IsDate(dt) = True Then dstr = cy & "/" & Format(dt, "mm/dd") rng.Cells(rw, cl) = dstr 'Debug.Print dstr End If Next cl Next rw End If End Sub
前は結構普通の日記も書いてたのに最近なんかマクロの保管場所でしか使ってない気がする。
Excel VBA でカタカナを全角に、英数字&記号を半角にするマクロ
半角カナと全角英数字のない世界に行きたい。
' アクティブシートの選択しているセルを含む範囲内の半角カナを全角に、全角英数字を半角にする ' マクロの参照設定に "Microsoft VBScript Regular Expressions 5.5" を追加する Sub han2zenkana() Dim r As Long, c As Long Dim re As RegExp Dim rng As Range Dim dat, rdat Dim m, matches Set re = New RegExp re.Global = True re.Pattern = "[A-Za-z0-9/.,() ]" If TypeName(Selection) <> "Range" Then Exit Sub Set rng = Selection.CurrentRegion rng.Select For r = 1 To rng.Rows.Count For c = 1 To rng.Columns.Count dat = rng.Cells(r, c).Formula If InStr(dat, "=") <> 1 And Len(dat) > 0 Then ' 関数でない場合のみ dat = StrConv(dat, vbWide) ' 一度全て全角に Set matches = re.Execute(dat) For Each m In matches dat = Replace(dat, m.Value, StrConv(m.Value, vbNarrow)) Next m rng.Cells(r, c) = dat Debug.Print r & " " & dat End If Next c Next r End Sub
追記:
以前書いたこのエントリの存在を忘れて正規表現使わないバージョンの関数書いてしまった。
' 指定したRange内の半角カナを全角に、全角英数字を半角にする Function Han2Zen(rng As Range) Dim han, zen, c Dim i As Integer han = Array( _ "ヴ", "ッ", "ャ", "ュ", "ョ", _ "ガ", "ギ", "グ", "ゲ", "ゴ", _ "ザ", "ジ", "ズ", "ゼ", "ゾ", _ "ダ", "ヂ", "ヅ", "デ", "ド", _ "バ", "ビ", "ブ", "ベ", "ボ", _ "パ", "ピ", "プ", "ペ", "ポ", _ "ア", "イ", "ウ", "エ", "オ", _ "カ", "キ", "ク", "ケ", "コ", _ "サ", "シ", "ス", "セ", "ソ", _ "タ", "チ", "ツ", "テ", "ト", _ "ナ", "ニ", "ヌ", "ネ", "ノ", _ "ハ", "ヒ", "フ", "ヘ", "ホ", _ "マ", "ミ", "ム", "メ", "モ", _ "ヤ", "ユ", "ヨ", "ー", "・", _ "ラ", "リ", "ル", "レ", "ロ", _ "ワ", "ヲ", "ン", "「", "」", _ "ァ", "ィ", "ゥ", "ェ", "ォ") zen = Array( _ "ヴ", "ッ", "ャ", "ュ", "ョ", _ "ガ", "ギ", "グ", "ゲ", "ゴ", _ "ザ", "ジ", "ズ", "ゼ", "ゾ", _ "ダ", "ヂ", "ヅ", "デ", "ド", _ "バ", "ビ", "ブ", "ベ", "ボ", _ "パ", "ピ", "プ", "ペ", "ポ", _ "ア", "イ", "ウ", "エ", "オ", _ "カ", "キ", "ク", "ケ", "コ", _ "サ", "シ", "ス", "セ", "ソ", _ "タ", "チ", "ツ", "テ", "ト", _ "ナ", "ニ", "ヌ", "ネ", "ノ", _ "ハ", "ヒ", "フ", "ヘ", "ホ", _ "マ", "ミ", "ム", "メ", "モ", _ "ヤ", "ユ", "ヨ", "ー", "・", _ "ラ", "リ", "ル", "レ", "ロ", _ "ワ", "ヲ", "ン", "「", "」", _ "ァ", "ィ", "ゥ", "ェ", "ォ") For Each c In rng.Cells c.Value = Application.WorksheetFunction.Asc(c.Text) Next c With rng For i = 0 To 84 .Replace What:=han(i), Replacement:=zen(i), LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next i End With End Function
こちらからは以上です。
Visustin Pro 版の Editor 機能早見表
Visustin – フローチャートジェネレイター っていうソース解析用のツールがある。
こんな感じで左側のボックスにソースを貼り付け、Drawボタンを押すと右側にフローチャートを書いてくれる。
解析だけなら無料版でも可能、且つたくさんの言語パターンに対応してるのでとても便利。
ただ、自動作図されたものは用紙枠などを考慮してないので、そのまま印刷しようとすると一部だけちょびっとはみ出たりして悲しいことに。
Pro版を購入すると、解析したデータを編集できるエディタがついてくる。上記のフローチャートを編集したのがこれ。Visioほどじゃないけど、コネクタ線の形状が選べるし後から図形を挿入したりもできるので、結構見栄えの良いものができる。
てことで、仕事で使おうと思ってPro版を買ったので、編集機能の練習がてら Editor の図形編集でできることをまとめた一覧を作った。メモ代わりに以下に貼り付けておく。
Pro版5万もするんで(それでもこの手のソフトの中では安い方らしいのだけども)どんだけの人が持ってるかわからんですがまあ。
Excel VBA 小ネタマクロ
例によって仕事中に現実逃避で作ったマクロを日記へメモっておこうと思ったら、久しぶりすぎてはてな記法忘れてる私です、こんにちは。
指定の列のデータを複数の列に振り分けるマクロ
説明が面倒くさいんでビフォーアフターを画像で貼り付けます。
これが、
こうなる
以下ソース。あ、内部でRangestrって自作関数使ってるのでそっちのソースもご利用下さい
'----------------------------------------------------------------------- Sub 行列入れ替えテスト() RowToColumns ActiveSheet, 1, 3 End Sub '----------------------------------------------------------------------- ' 指定の列の値を指定の行数ごとに隣の列にコピーして空になった行を削除するマクロ Sub RowToColumns(sh As Worksheet, col As Long, cols As Long) Dim dr As Long, er As Long Dim i For i = 1 To cols ' コピー先の列を作る sh.Columns(col + 1).Insert Next i er = 0 dr = 1 Do While er < 100 If sh.Cells(dr, col).Value = "" Then er = er + 1 ' データがない行はスキップ Else er = 0 Application.ScreenUpdating = False sh.Range(RangeStr(dr + 1, col, dr + (cols - 1), col)).Copy sh.Cells(dr, col + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True Application.CutCopyMode = False sh.Rows(RowsStr(dr + 1, dr + (cols - 1))).Delete Shift:=xlUp Application.ScreenUpdating = True End If dr = dr + 1 Loop End Sub
指定の列にデータがない行を削除するマクロ
これも面倒なんでビフォーアフター画像から察して下さい。
これが
こうなる
サンプルみたいな単純な表だとNo.列でソートしてから削除するほうが手っ取り早いんですが、大人の事情でソートしちゃうと前後がぐちゃぐちゃになって再利用しにくい表などもあるのです。
以下ソース。
'----------------------------------------------------------------------- ' 指定範囲の空行を削除する Sub 空行削除() Dim sh As Worksheet Dim sel As Range If TypeName(Selection) = "Range" Then Set sh = ActiveSheet Set sel = Selection EmptyRowDelete sh, sel.Row, sel.Row + sel.Rows.Count, 2 End If End Sub '----------------------------------------------------------------------- ' 指定の列にデータが含まれない行を削除するマクロ ' チェックする列は3つまで '----------------------------------------------------------------------- ' 指定の列にデータが含まれない行を削除するマクロ ' チェックする列は3つまで Sub EmptyRowDelete(sh As Worksheet, srow As Long, erow As Long, _ col1 As Long, Optional col2 As Long = 0, Optional col3 As Long = 0) Dim r As Long, cf1 As String, cf2 As String, cf3 As String cf1 = "" cf2 = "" cf3 = "" For r = erow To srow Step -1 If col1 > 0 Then cf1 = sh.Cells(r, col1).Value End If If col2 > 0 Then cf2 = sh.Cells(r, col2).Value End If If col3 > 0 Then cf3 = sh.Cells(r, col3).Value End If If cf1 = "" And cf2 = "" And cf3 = "" Then sh.Rows(r).Delete Shift:=xlUp End If Next r End Sub
いわずもがなですが
例によってエラーチェックとかいろいろ気遣いをしてないマクロなので、使った結果何が起きてもフォローできません。
実行の際は直前に文書を保存したり、シートをコピーしたりして万全の準備整えておいていただけると幸いです。
ネットにつながんなくなった
先日来、なぜか会社のマイPCがインターネットにつながらなくなった。
といっても同じローカルネット内にぶら下がってるNASやプリンタにはつながるので普段の仕事にはほぼ差し障りがなく、ちょっと調べ物をしようとしてネットを見ようとしたりメールを確認しようとしないかぎり気が付かない。
(あと息抜きでついった見ようとか思わない限りな! …なのでまあ割とすぐに気が付いたわけだが^q^)
ネットワークセンターで確認すると、社内ネットワークのほかに識別されていないネットワークというのが存在する。これのせいで外に出ていけなくなってるらしい。
まて、ネットワークアダプタはオンボの一個だけなのになんでネットワーク二つあるの。
いぶかしみながらPCを再起動すると、この「識別されてないネットワーク」は消えて、外に出ていけるようになった。
が、次の日またPCの電源入れると「識別されてないネットワーク」が復活する。再起動すれば消えるが面倒くさい。次の日はデバイスマネージャでオンボのネットワークアダプタを無効>有効に切り替えるだけでも消えるのが分かったけど、それもやっぱ毎朝やるのは面倒くさい。
なんだろうなあ……、ここ最近PC周りで変わったことといえば、10年くらい使ってた有線ルータの調子が悪くなったので新しいルータに置き換えたくらいだ。他のPCは(持ち込んでる個人用のノートなども含め)なんともないので、このPCのなにかだけが新しいルータと相性が悪いのかもしれない。
再起動してネットにつながるようになってからぐぐってみたら、この、識別されてないネットワークのせいでインターネットにつながらなくなるという問題は Windows だとよくあることらしい。
しかし自分ところがなぜこうなったかはわからなかった。
識別されていないネットワークができちゃうのは Bonjour が悪さしてるという情報が一番上にあって、確かにこのPCには Adobe CS3 入ってるけどサービス一覧に Bonjour いないし、そもそもルータ変えるまでは今の環境で問題なかったのだし
……まあ原因は分からないけど治ればいいやと割り切る。
で、route コマンドでいらないデフォルトゲートウェイを消し、正しいデフォルトゲートウェイを設定しなおす、という対策方法をゲット。
参考にしましたありがとう→ 俺の覚書 Windows7が急にネットワークに繋がらなくなった
次の日、電源入れた直後のネットにつながらない状態でメモした通りに route コマンド打ち込んでデフォルトゲートウェイが正しく設定され、ネットにもつながることを確認し、一安心。
んで次の日。またつながらなくなってるー!
ipconfig みたらデフォルトゲートウェイに 0.0.0.0 が復活してる shit
で route コマンドを再入力。えーこれ毎日やんのか面倒。
てことでバッチファイルを作成。ログオン時にバッチファイルを管理者権限で実行させるやり方をググり、タスクスケジューラに登録。
これで明日からは幸せになれるのだろうか。
ていうか何が悪いんだろうなあほんと……。
Windows 7 のスタートアップフォルダ
勝手にアプリケーションをスタートアップ登録してくれるおせっかいなインストーラのせいで半年ごとに探すはめになるので、メモ。
- すべてのユーザー
- %SystemDrive%:\Users\All Users\Microsoft\Windows\Start Menu\Programs\Startup
- 自分専用
- %SystemDrive%:\Users\%USERNAME%\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup
二か所あるのがまたうざい。
WindowsXPまではスタートボタン右クリックでフォルダ表示できたのに何でやめちゃったんでしょうね。
こっからは、絶対パスがわかればいいって人にとってはどうでもいい話。
↑上記のシステムドライブやユーザー名部分を環境変数で書いてるわけだがシステムドライブを表す環境変数名が自信なかったので、一応公開前にネットで検索して確認することにした。
最初に見つけたのが@ITにあったシステム環境変数とその変数がさす内容のリスト。しかし、このリストは書かれたのが2003年なため、内容もWindows98からXPまでと古い。環境変数自体は今でも使えるものだけど、フォルダの絶対パスはずいぶんと変わってきているんだなあと思った。
新しいバージョンはないのかとさらに検索を続け、Microsoft公式にちゃんとWindows 7と8でのデフォルトパスが乗っている環境変数一覧があるのを発見した。しかもよくよく見るとスタートアップフォルダの位置も載っているじゃあないですか。
環境変数で調べればもっと早くスタートアップの位置が分かったのかあ……。と、今更。
あ、Windows 8 もWindows 7と同じ位置のままみたいです。よかったね。(追記:Windows 10 も同じでした。やったね)
列名変換
久々にExcelでマクロ組んでいて列名を数字に変換しないといけない部分が出てきた。
そういえば、ずいぶん前のはてブにExcelの列名変換をお題にプログラミングコンテストをして〜というエントリが上がってて、自分でもやってみようとVBAで作ってみた記憶があった。が、マイドキュメントあさってみたがそれっぽいファイルが残っていない。
お題があったblogの別エントリで回答がのっていたはずだし、ブコメや関連リンクでさまざまな回答寄せられていたことは覚えてる。たぶんブックマークからたどればそれらを見つけることは可能。だが、何となく悔しいので、あえて元エントリも回答も見ずに作り直してみた。
Option Explicit Sub test() Dim s As String Dim i, c For i = 1 To 1000 s = ColStr(i) c = StrCol(s) Sheets("Sheet2").Cells(i, 1).Value = i Sheets("Sheet2").Cells(i, 2).Value = s Sheets("Sheet2").Cells(i, 3).Value = c Next i End Sub ' 文字列から列番号を返す Function StrCol(cs As String) Dim up, l, i, r, c up = StrConv(cs, vbUpperCase) l = Len(cs) r = 0 If l > 0 Then For i = 0 To (l - 1) c = Asc(Mid(up, l - i, 1)) - &H40 r = r + ((26 ^ i) * c) Next i End If StrCol = r End Function ' 列番号から文字列を返す(A〜ZZZ) Function ColStr(c) As String Dim C1, C2, C3, cc If c > (676 + 26) Then C1 = Int(Int(c / 26) / 26) C2 = Int(Int(c / 26) Mod 26) C3 = c Mod 26 If C2 = 0 Then C1 = C1 - 1: C2 = 26 If C3 = 0 Then C2 = C2 - 1: C3 = 26 ColStr = Chr(C1 + &H40) & Chr(C2 + &H40) & Chr(C3 + &H40) ElseIf c > 26 Then C1 = Int(c / 26) C2 = c Mod 26 If C2 = 0 Then C1 = C1 - 1: C2 = 26 ColStr = Chr(C1 + &H40) & Chr(C2 + &H40) ElseIf c > 0 Then ColStr = Chr(c + &H40) End If End Function
VBAエディタを開いてからStrColを正しく動くようにするまでに45分。変換のロジックはわかっていたものの、どういう関数を使ってどう評価させればいいのかという部分でだいぶ時間を食ったなあという感想。
検算用に使っているColStrはこれまた必要に迫られてずいぶん前に作った関数(d:id:Nikki_A:20100728)。本当は再帰など駆使して作るべきものなんだろうけど、現在のExcelの仕様では3ケタあれば十分なのでこのままでいっかーと放置してある。
と。
ここまで元エントリ読まずに書きあげ、それから自分のブクマの過去ログあさって発掘してきた。
http://blog.jnito.com/entry/20111102/1320253815 <元記事
http://b.hatena.ne.jp/entry/blog.jnito.com/entry/20111102/1320253815 <ブクマ
ああ……問題2の存在を忘れていた。ColStrをきちんと作り直すか。また忘れたころに。