つらつら Excel VBA

私の備忘録です。

VBA

コマンド実行結果を受け取る

PowerShellも同じやり方。渡すテキスト変えるだけ。 コマンドにオプション付けたり、Splitなどを使って結果を取捨選択してください。 Sub コマンドプロンプト() Dim WSH, wshExec, sCmd As String, sResult As String Set WSH = CreateObject("WScript.Shell…

セルの幅と高さサイズ指定

Sub セルの幅と高さサイズ指定() With ActiveSheet '自動調整確認用テスト文字 '.Range("A1:G10").Value = "aaaaaaaa" 'サイズ一括指定 .Cells.RowHeight = 30 .Cells.ColumnWidth = 5 '基準値に戻す .Rows("2").UseStandardHeight = True .Columns("A").Use…

複数のテキストファイルを読み込む処理

'参照設定 Microsoft Scripting Runtime Sub 複数のテキストファイルを1行ずつ読み込む処理FSO() Dim tempFolder As String tempFolder = ThisWorkbook.Path & "\temp\" Dim f As File Dim ts As TextStream Dim fso As FileSystemObject Set fso = New File…

色からRGB値を算出

Sub セルの背景色をRGBで取得() 'セルの背景色を取得 Dim iColor As Long iColor = ActiveCell.Interior.Color '算出 Dim iR As Long, iG As Long, iB As Long iR = iColor Mod 256 iG = Int(iColor / 256) Mod 256 iB = Int(iColor / 256 / 256) Debug.Prin…

1,600万色を56色に減色する

とりあえずセルの背景色を減色した。深く考えない! Sub カラーインデックス56色に書き換え() Dim r As Range For Each r In ThisWorkbook.ActiveSheet.UsedRange With r.Interior If .ColorIndex <> xlNone Then .ColorIndex = .ColorIndex End If End With…

VBAでGetPixel

ディスプレイ上のどこでも色情報を取得できるAPIのGetPixel。100x100ピクセルくらいの範囲でも激重なので注意! 読み取り範囲と基準座標はポイントとピクセルとインチとdpiの計算が必要でハードルが高いと思います。 色情報を取得できたら、シートのセルの背…

ディスプレイ上の画像位置を取得する(DPI値の注意)

ピクセル=ポイント×96/72 インチ変換計算が必要で72で割ってます。問題は96の部分。 'ディスプレイ上におけるA1の左上の位置を取得する。ピクセル値。 x = ActiveWindow.PointsToScreenPixelsX(0) y = ActiveWindow.PointsToScreenPixelsY(0) 'A1の左上か…

画像ファイルをシートに表示

Sub 画像ファイル読み込みテスト() Dim myFileName As Variant Dim myShape As Shape 'ファイル選択ダイアログ myFileName = Application.GetOpenFilename 'キャンセルやサイズ0の場合は処理終了 If myFileName = False Then Exit Sub If FileLen(myFileName…

ブラウザ操作(Chrome、SeleniumBasic)

GoogleChromeを操作したい。SeleniumBasicが必要とのこと。 事前準備は割愛。 マクロ側からページ内にアクセスする時はロード待ち処理を必ず入れる。 IEで出来てた全選択コピー貼り付けがうまくいかず、、、諦めてデータは直接取得。 Dim driver As Selenium…

VBAでワークシート関数を使う(CountA)

A~H列が全て空白の行を見つける処理。 iRow = 2 Do While Application.WorksheetFunction.CountA(Range("A" & iRow & ":H" & iRow)) > 0 '何か処理を入れる iRow = iRow + 1 Loop ワークシート関数CountAは空白ではないセルの個数を返す。以上。

余白設定

'余白設定 With ThisWorkbook.Worksheets("Sheet1").PageSetup .LeftMargin = Application.CentimetersToPoints(1.8) .RightMargin = Application.CentimetersToPoints(1.8) .TopMargin = Application.CentimetersToPoints(1.9) .BottomMargin = Application…

Trimとデータ型について

セル内の文字の前後に空白があると、セル編集で中身を見てみないことには分からず気づきにくい。 そんな時は文字の前後にある空白を除去してくれるTrim便利。Trim(引数)、戻り値はString前後の空白は全て敵!何も考えずこんな感じの脳筋プログラムを作りまし…

オートフィルタ解除後にも絞り込み状態を継続させたい

非表示行を覚えておいて、復元させるだけです。 (オートフィルタを解除しなければいいだけの話では・・・?) Sub オートフィルタで絞り込んで解除して非表示状態を復元する処理() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("エクセルシート")…

長いコードと行継続文字の使い過ぎ

エディタが文句ばかり言います。行が長すぎます。行継続文字を使いすぎています。 仕方ないのでコードの後半の改行は諦めました。画面外にはみ出したままです。 これでは見づらい! なんかすごい アンダーバーは24個まで。横に長すぎるコードは怒られます。…

オートフィルタ使用時のセル位置復元

オートフィルタの絞り込み条件を解除するとセル位置がどこいった状態になるのを対策。 保存するか確認されるのは嫌なので回避する処理も入れてみた。かなり快適。 Sub オートフィルタリセット処理() On Error Resume Next '本処理だけが更新内容なら保存しな…

正規表現でひらがなを検出したい

'参照設定 'Microsoft VBScript Regular Expressions 5.5 Sub 正規表現テスト() Dim RE As New RegExp 'Set RE = CreateObject("VBScript.RegExp") Dim Matches, Match Dim strPattern As String Dim r As Range strPattern = "[ぁ-ん]" 'ひらがな比較 'strP…

フォントをMSPゴシックに一括変更

同一フォルダのエクセルファイル全部に対してフォントを変える処理。 行列番号部分はスタイルで指定されている模様。この処理だけでは無理。 Sub ゴシック統一() Dim buf As String, folderPath As String Dim ws As Worksheet, wb As Workbook folderPath =…

Like比較メモ、ひらがなだけ取得

VBA

ひらがなだけ取り出して、ついでにひらがな以外も取得。 For i = 1 To Len(tmp) If Mid(tmp, i, 1) Like "[あ-ん]" Then hiragana = hiragana & Mid(tmp, i, 1) Else sonota = sonota & Mid(tmp, i, 1) End If Next i '別解 For i = 1 To Len(tmp) s = Mid(t…

Word文書の置換(Excel)

とりま最近つくったやつ。 エクセル側からワード文書内で検索と置換をするだけのものです。 どうやら改行を含む文字の場合は何かしら手を打たないといけない模様。 使う場合は参照設定をしましょう。(Microsoft Wordなんたら) Sub chikan() Dim path As St…

セル範囲を図として貼り付け

印刷時に便利かも With Sheets("Sheet1") .Range("A2:C6").Copy .Pictures.Paste .Pictures.Paste Link:=True End With 普通のコピペ処理でもできました コピー元を変更すると、link指定した図に反映する! リンクってそういう意味なのか? 以上

罫線

とりま最近使った総勘定元帳から抜粋 With newSheet .Range("A2:H10").Borders.LineStyle = xlContinuous '実線 .Range("A3:H10").Borders(xlInsideHorizontal).Weight = xlHairline '極細 .Range("B2:C10").Borders(xlEdgeLeft).LineStyle = xlDouble '二重…

勘定科目順にエクセルシートを並び変えする処理

確定申告の時に適当に作りました。動けばヨシ!勘定科目ってカテゴリーさえ合ってれば名前は自由に決められるようで、並ばせるの無理じゃね?ということで、用意したリストの通りに強制的に並ばせる処理をします。該当しないものはスキップし、自動的に最後…

ページ設定

とりま最近使ったヤツ With ThisWorkbook.Worksheets(1).PageSetup .PrintTitleRows = "$1:$2" 'タイトル行 .CenterFooter = "&P / &N" 'ページ番号 .Zoom = 80 '拡大率 End With 以上

極細線

VBA

10年くらい点線だと思ってた(笑) .Range("A1:H20").Borders.LineStyle = xlContinuous .Range("A2:H20").Borders(xlInsideHorizontal).Weight = xlHairline 以上

新規ブックのシート枚数を指定する

Excel2013から2019にしたら新規シートが1枚になってて驚いた。 '新規ブックのデフォルトシート枚数を1に変更してすぐ戻す Dim newWb As Workbook Dim sinw As Integer sinw = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set newW…

オートフィルタの結果に対して処理

ws.Range("A2").AutoFilter Field:=3, Criteria1:="誕生" For Each r In ws.AutoFilter.Range.SpecialCells(xlCellTypeVisible) If r.Row > 2 And r.Column = 4 Then 'オートフィルタ範囲の可視セルで2行目以降のD列だけ処理 End If Next 無理やりです。出来…

オートフィルタの絞り込み結果件数取得

ws.Range("A2").AutoFilter Field:=2, Criteria1:="ピカちゅう" If WorksheetFunction.Subtotal(3, Range("C:C")) = 1 Then '結果が0件の場合の処理。 End If この処理は、オートフィルタを実施して、C列をCOUNTAした結果、タイトル行の1件しか無かった=フ…

オートフィルタの複数条件設定

'それぞれの列で条件を指定したい時、それぞれ指定すればよい With ws.Range("A1") .AutoFilter Field:=2, Criteria1:="ピカちゅう" .AutoFilter Field:=3, Criteria1:="誕生" End With '配列を渡して一括設定。Arrayとかもできる。 Dim dic, ar '略。条件用…

ランダムパスワード生成

'パスワードに使う半角英数字と記号を指定 '各文字セットから必ず1文字が使われる Const PASS_CHAR_1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Const PASS_CHAR_2 = "abcdefghijklmnopqrstuvwxyz" Const PASS_CHAR_3 = "0123456789" Const PASS_CHAR_4 = "!@#$%^&*_+…

CollectionとDictionary

VBA

Collectionのキーは大文字小文字関係なし、TestとTESTが同じ扱い。 Dictionaryのキーは完全一致。TestとTESTは別物扱い。 以下、ざっくりとした使い方の違い。 Sub DictionaryTest() Dim dic As Object Set dic = CreateObject("Scripting.Dictionary") 'Dic…