文字列のCheck

先生：このマクロな、「A列に ABC がある」「C列が 0 や」「G列に NDEF がある」かを調べるやつやで。 生徒：なんで配列使ってんの？ 先生：ええ質問やな！配列使うと、まとめてデータ読み込んで、まとめて処理できるからめっちゃ速いんや。1個ずつ見てたら遅いからな。 生徒：この InStr って何してるん？ 先生：「この文字入ってるか〜？」って調べる関数や。たとえば InStr(aVal, "ABC") やったら、「aVal の中に ABC あるかな？」ってことやで。 生徒：ほんで、Z列にはどう書いてんの？ 先生：ループ終わったあと、Z列（2行目から）に結果の配列を一気に書いてるんや。せや…

A1セル値チェックしてC1に書き込み

生徒：先生、このコードって何してるん？先生：A1のセルに「対象1」か「対象2」って書いてあるか見てるねん。生徒：で、書いてあったらどうなんの？先生：「対象1」って書いてあったら、C1に「置換文字1」って書く。先生：「対象2」やったら、「置換文字2」って書く。先生：どっちもちゃうかったら、C1には何も書かへん。生徒：InStrってなんや？先生：文字が入ってるかどうか調べる関数や。たとえば「こんにちは」っていう文字の中に「にち」があるかどうかを調べる感じや。生徒：LCaseって？先生：全部小文字にする関数や。大文字小文字を区別せんようにするためやな。生徒：なるほどな。A1の文字を見て、C1に何を書…

「ソート解除後のデータ削除

先生: 「このコードはな、Excelでソート（並び替え）を元に戻してから、データを消すっていう処理をしてるんや。」 生徒: 「ふむふむ、並び替えを元に戻す？それってどういうこと？」 先生: 「たとえばな、表の中で“名前をあいうえお順に並べる”みたいなことをした後、その並びをリセットして、元の状態に戻すんや。」 生徒: 「あー、並び替えたのをやめて、最初の順番に戻すってことか！」 先生: 「そうそう。そしてその後、その表の中のデータだけを消すねん。表のタイトルとか枠はそのままでな。」 生徒: 「データだけ消すんやな！全部じゃないんや！」 先生: 「その通り！あとな、このコードは“テーブル”ってい…

差分をチェックして書き込み

先生: 「このコードは、Excelのシートで、C列の値とその行の一番右にある値を比べて、その差を表示するものなんや。」 生徒: 「ふむふむ、それってどういうこと？」 先生: 「たとえばC列に“予定の数値”、右の方に“実際の数値”があるとするやろ？それを比べて、差があるか調べるんや。」 生徒: 「C列と右端の数字を比べるんやな。」 先生: 「そうそう。まずは、C列にどこまでデータがあるかを調べて、2行目から最後の行まで順番に見ていくんや。」 生徒: 「行ごとに見るってことやね。」 先生: 「そんで、その行の中で、一番右にあるセルを見つける。つまり、一番最後に入力されてる数字やな。」 生徒: 「な…

集計結果作成

先生: 「このコードは、指定したフォルダ内のExcelファイルから、データを集めて、新しいExcelファイルを作成するものなんや。」 生徒: 「ふむふむ、それってどういうこと？」 先生: 「まず最初に、どのフォルダからデータを集めるかを選ぶ画面が出てくるんや。」 生徒: 「あー、フォルダを選ぶんやね。次は？」 先生: 「フォルダを選んだ後、その中にあるExcelファイルを1つずつ開いて、その中の 'data' って名前のシートを探してくるんや。」 生徒: 「'data'シートを探すんやな。」 先生: 「そう！もし 'data' シートがあったら、その中身を新しいExcelファイルにコピーするん…

シート名検索して転記

生徒: 先生、このコードは何をしてるんですか？ 先生: このコードは、あるシートにあるデータの中から、「●」って印がついてる行だけを取り出して、それを別のひな形のブックに転記するんやで。 生徒: なるほど、でも「●」印をどうやって探すんですか？ 先生: そこは、InStrっていう関数を使ってるんや。これを使うと、指定した文字列（ここでは「●」）が含まれてるかをチェックできるんやで。あいまい検索もできるから、部分一致でもOKや。 生徒: あいまい検索？つまり「●」が部分的に入ってても探せるってこと？ 先生: その通り！たとえば「xxx●」や「●abc」みたいに、どこかに「●」があればその行を探し…

シートの転記

生徒：先生、このコードは何をしてるんですか？先生：このコードは、シート1のA列、B列、D列、F列、H列のデータを取り出して、それをシート2に転記するものやで。 生徒：どうやってデータを取り出してるんですか？先生：まず、シート1の最後の行を確認して、そのデータを配列にまとめて取り出すんや。その配列を使って、シート2に一気にデータを転記するんや。 生徒：配列にまとめるってどういうことですか？先生：配列にデータをまとめることで、シート1からシート2に一度に大量のデータを転記できるようになるんや。これで効率がめっちゃ良くなるんやで。 生徒：シート2にはどうやって転記されるんですか？先生：シート2では、…

グラフのデータ抽出

Sub グラフデータ抽出() Dim NumberOfRows As Integer Dim X As Object Dim Counter As Integer ' Counter を 2 で初期化 Counter = 2 ' アクティブなグラフが存在するか確認 If Not ActiveChart Is Nothing Then ' 最初の系列の値から行数を取得 NumberOfRows = UBound(ActiveChart.SeriesCollection(1).Values) ' "Data" シートにデータを書き込む With Worksheets("Data") ' X軸の値を…

コメントを追加する

Sub コメントを追加する() ’例)A列が●●●の場合 数値の+/-の判断コメント追加 Dim i As Long Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row ' A列の最終行を取得 For i = 1 To lastRow If IsNumeric(Cells(i, 1).Value) Then ' 数値が入っているかチェック If Cells(i, 1).Value > 0 Then Cells(i, 3).Value = "●●●の増加＋" & Format(Cells(i, 1).Value, …

条件による転記作業

Sub ExtractColumnsWithNNNUsingArray() Dim wsSearch As Worksheet Dim wsTarget As Worksheet Dim lastRow As Long Dim targetRow As Long Dim i As Long Dim searchValue As String Dim dataArr As Variant Dim resultArr() As Variant Dim resultIndex As Long ' 検索結果シートを設定 Set wsSearch = ThisWorkbook.Sheets("Data"…

2つのsheet比較と色付け 合計追加版

Sub 2つのsheet比較と色付け() Dim wsPrev As Worksheet Dim wsCurr As Worksheet Dim wsResult As Worksheet Dim lastRowPrev As Long Dim lastRowCurr As Long Dim lastColPrev As Long Dim lastColCurr As Long Dim dictPrev As Object Dim dictCurr As Object Dim i As Long, j As Long Dim key As Variant Dim diffRow As Long…

C列のデータを基にD列を更新

Sub C列のデータを基にD列を更新() Dim lastRow As Long Dim i As Long Dim data As Variant ' 配列としてデータを格納 Dim result As Variant ' 結果を格納する配列 ' C列の最終行を取得 lastRow = Cells(Rows.Count, "C").End(xlUp).Row ' C列のデータを配列に読み込む data = Range("C1:C" & lastRow).Value ' 結果を格納する配列を準備（同じサイズの配列） ReDim result(1 To lastRow, 1 To 1) ' 配列…

バックグラウンドでの列削除処理

Sub バックグラウンドでの列削除処理() Dim ExcelApp As Object Dim Workbook As Object Dim FilePath As String ' Excelファイルのパス（実際のパスに変更してください） FilePath = "C:\path\to\your\file.xlsx" ' ファイルパスを変更 ' Excelをバックグラウンドで起動 Set ExcelApp = CreateObject("Excel.Application") ExcelApp.Visible = False ' Excelを非表示にする ExcelApp.DisplayAl…

バックグラウンドでの行削除処理

Sub バックグラウンドでの行削除処理() ' 条件付き書式を削除 ' データ入力規則を削除 Dim ExcelApp As Object Dim Workbook As Object Dim FilePath As String Dim LastRow As Long Dim MaxLastRow As Long Dim LastRows(1 To 26) As Long ' A列からZ列までの最終行を格納する配列 Dim DeleteRange As Object Dim Col As Integer ' Excelファイルのパス FilePath = "C:\path\to\your\f…

不要行列の削除方法 色々

Sub 3000行以下削除() ' 条件付き書式を削除 ' データ入力規則を削除 Dim LastRow As Long Dim MaxLastRow As Long Dim LastRows(1 To 26) As Long ' A列からZ列までの最終行を格納する配列 MaxLastRow = 0 ' 初期値として0を設定 ' A列からZ列までを配列に格納 For Col = 1 To 26 ' A列(1) から Z列(26)まで LastRows(Col) = Cells(Rows.Count, Col).End(xlUp).Row ' 各列の最終行を配列に格納 If LastRows(C…

ファイル統合

Sub ファイル統合() Dim folderPath As String Dim fileName As String Dim wb As Workbook Dim wsSource As Worksheet Dim wsDest As Worksheet Dim lastRow As Long Dim destRow As Long Dim dataArray() As Variant Dim combinedData() As Variant Dim i As Long, j As Long Dim dataIndex As Long Dim savePath As String Dim…

セル値を 文字列として変換

Sub セル値を文字列へ() Dim cell As Range Dim result As String Dim rng As Range ' 範囲選択用のダイアログを表示 On Error Resume Next ' ユーザーがキャンセルした場合のエラー処理 Set rng = Application.InputBox("セル範囲を選択してください", Type:=8) ' Type:=8 は範囲選択を意味します On Error GoTo 0 ' エラー処理を元に戻す ' ユーザーが範囲を選択しなかった場合の処理 If rng Is Nothing Then MsgBox "範囲が選択さ…

Access 汎用的な関数

1. Nz関数 Nzは、Null値を他の値に置き換えるための関数です。 使い方: Nz([フィールド名], 代替値) 例:Nz([Amount], 0)これは、[Amount]がNullの場合、0を返します。 2. DateAdd関数 DateAddは、日付に特定の間隔を追加する関数です。 使い方: DateAdd("間隔", 数量, 日付) 例:DateAdd("d", 5, [OrderDate])これは、[OrderDate]の日付に5日を加算します。 3. DateDiff関数 DateDiffは、2つの日付の差を指定した単位で計算します。 使い方: DateDiff("間隔", 日付…

フォルダー選択

Sub フォルダー選択() Dim folderPath As String Dim dialog As FileDialog Dim initialFolder As String ' 初期選択フォルダーを設定 initialFolder = "C:\Users\YourUsername\Documents" ' 任意のフォルダーパスに変更 ' フォルダー選択のダイアログを作成 Set dialog = Application.FileDialog(msoFileDialogFolderPicker) ' 初期フォルダーを設定 dialog.InitialFileName = initial…

複数条件でデータを検索して抽出する

Sub 複数条件でデータ検索() Dim ws As Worksheet Dim lastRow As Long Dim dataRange As Range Dim dataArray As Variant Dim resultArray() As Variant Dim specifiedItem2 As String Dim specifiedItem3 As String Dim i As Long, resultRow As Long Dim folderPath As String Dim fileName As String Dim newBook As Workbook Dim…

シート1とシート2の差分と追加データを抽出

機能: 一致データ: シート1のA列とB列をキーにし、その組み合わせがシート2にも存在する場合、そのデータを「一致データ」として3列目に記録します。 差分データ: シート1にはあるがシート2にはないデータは、1列目に「差分データ」として記録されます。 新規追加データ: シート1にはなくシート2に新規で追加されたデータは、2列目に「新規追加データ」として記録されます。 使用方法: VBAコードをExcelに追加します（Alt + F11 → 新しいモジュールを挿入）。 比較したいシート名（Sheet1, Sheet2）や比較する列（A列とB列）を適切に変更してください。 VBAを実行すると、「比…

可視セルのみ連番

Sub 可視セルのみ連番() Dim cnt As Long cnt = 1 Dim cell As Range For Each cell In Selection.Cells If cell.EntireRow.Hidden = False And cell.EntireColumn.Hidden = False Then cell.Offset(0, -1).Value = cnt & "." cnt = cnt + 1 End If Next cell End Sub

2つのsheet比較結果 色付追加

Sub 2つのsheet比較と色付け() Dim wsPrev As Worksheet Dim wsCurr As Worksheet Dim wsResult As Worksheet Dim lastRowPrev As Long Dim lastRowCurr As Long Dim lastColPrev As Long Dim lastColCurr As Long Dim dictPrev As Object Dim dictCurr As Object Dim i As Long, j As Long Dim key As Variant Dim diffRow As Long…

2つのsheet比較コメント追加

Sub 2つのsheet比較コメント追加() Dim wsPrev As Worksheet Dim wsCurr As Worksheet Dim wsResult As Worksheet Dim lastRowPrev As Long Dim lastRowCurr As Long Dim lastColPrev As Long Dim lastColCurr As Long Dim dictPrev As Object Dim dictCurr As Object Dim i As Long, j As Long Dim key As Variant Dim diffRow As Lo…

2つのシート比較(配列版)

Option Explicit Sub 2つのシート比較() Dim wsPrev As Worksheet Dim wsCurr As Worksheet Dim wsResult As Worksheet Dim lastRowPrev As Long Dim lastRowCurr As Long Dim lastColPrev As Long Dim lastColCurr As Long Dim dictPrev As Object Dim dictCurr As Object Dim i As Long, j As Long Dim key As Variant Dim diffR…

2つのsheet比較

Sub CompareSheets3) Dim wsPrevious As Worksheet Dim wsCurrent As Worksheet Dim wsResult As Worksheet Dim lastRowPrev As Long Dim lastRowCurr As Long Dim lastCol As Long Dim r As Long, c As Long Dim keyPrev As Variant Dim keyCurr As Variant Dim matchFound As Boolean Dim dictPrev As Object Dim dictCur…

cmd.CreateParameter で使用する一般的なデータ型（文字列、数値、日付）の設定方法

1. 文字列（String）文字列の場合、データ型として adVarChar（8）を使います。 例：cmd.Parameters.Append cmd.CreateParameter(, 8, 1, 255, "Department A")8: adVarChar（可変長文字列型）1: adParamInput（入力用パラメータ）255: 最大文字数（ここでは255文字まで）"Department A": 実際に渡す文字列 2. 数値（Numeric）数値の場合、データ型として adInteger（3）、adDouble（5）などを使用します。adInteger は整数型、adDouble は…

文字列、数値、日付を使ったサンプルコード

Sub ExcelからAccessデータ抽出パラメータ条件付き() ' Microsoft ActiveX Data Objects 2.X LibraryとMicrosoft ADO Ext.x.x for DDL and SecurityをVBEツールから参照設定 Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim cmd As ADODB.Command Dim dbPath As String dbPath = "D:\ThinkpadMark3\自学\filename変更_bat類\.xlsm\Accessへのexpo…

データ型一覧

データ型一覧 データ型 定数番号 説明 文字列 8 adVarChar（可変長文字列） 整数 3 adInteger（整数型） 浮動小数点数 5 adDouble（浮動小数点型） 日付 7 adDate（日付型） ブール（論理値） 11 adBoolean（論理値型）

Excelからアクセスデータ抽出時、パラメータをエクセルセル値から読み取りさせる('cmd.Parameters.Append利用)

Sub ExcelからAccessデータ抽出パラメータ条件付き()'cmd.Parameters.Append利用 'Microsoft ActiveX Data Objects 2.X LibraryとMicrosoft ADO Ext.x.x for DDL and SecurityをVBEツールから参照設定 Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim cmd As ADODB.Command Dim dbPath As String dbPath = "D:\ThinkpadMark3\自学\filename変更_…

#N/A行削除

Sub DeleteRowsWithNA() Dim lastRow As Long Dim i As Long Dim ws As Worksheet ' アクティブシートを設定 Set ws = ActiveSheet ' 最終行を取得 lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row ' 逆方向にループして行を削除 For i = lastRow To 2 Step -1 ' ヘッダーが1行目だと仮定して2から開始 If IsError(ws.Cells(i, 3).Value) Then ' "項目3"列が#N/Aの場合 If w…

転記処理(アクティブシートと右隣シートの比較結果の転記)

Sub 転記処理() Dim wsActive As Worksheet, wsNext As Worksheet Dim lastRowActive As Long, lastRowNext As Long Dim i As Long, j As Long Dim found As Boolean ' アクティブシートをwsActiveに設定 Set wsActive = ThisWorkbook.ActiveSheet ' アクティブシートの右隣のシートをwsNextに設定 Set wsNext = ThisWorkbook.Sheets(wsActive.Index + 1) ' アクテ…

指定された条件に基づいて項目の設定判定する

Sub 設定判定1() Dim lastRow As Long Dim i As Long ' 最終行の取得（項目3がある列の最終行） lastRow = Cells(Rows.Count, 3).End(xlUp).Row ' 項目3のデータを順番にチェック For i = 2 To lastRow ' 項目3（C列）がNNNの場合 If Cells(i, 3).Value = "NNN" Then Cells(i, 4).Value = "〇" Else Cells(i, 4).Value = "×" End If Next iEnd SubSub 設定判定2() Dim lastRow …

特定の条件に応じて列を変更するコード

Sub SetValuesBasedOnCondition() Dim rng As Range Dim cell As Range Dim lastRow As Long ' 列Aの最終行を取得 lastRow = Cells(Rows.Count, 1).End(xlUp).Row ' チェックする範囲を最終行まで設定 Set rng = Range("A1:A" & lastRow) ' 範囲内のセルをループ For Each cell In rng If cell.Value = "サンプル1" Then cell.Offset(0, 13).Value = A ' N列にAをセット …

ActiveSheetをダイアログ表示によるbook選択後、転記

Sub CopySheetToAnotherWorkbook() Dim ws As Worksheet Dim targetWorkbook As Workbook Dim newSheet As Worksheet Dim dialog As FileDialog Dim selectedFile As String Dim currentDate As String Dim newSheetName As String Dim targetSheet As Worksheet ' アクティブシートを取得 Set ws = ActiveSheet ' 転記先ブックを選択するダイアログを表示…

Outlookmail検索

Sub SaveEmailDetailsWithAttachmentsAndSubjectCriteria2() Dim olApp As Object Dim olNamespace As Object Dim olFolder As Object Dim olMail As Object Dim olAttachment As Object Dim SaveFolder As String Dim FileName As String Dim FilePath As String Dim FileNumber As Integer Dim StartDate As Date Dim End…

別シート情報転記

Private Sub Worksheet_Change(ByVal Target As Range) Application.CutCopyMode = False Sheets("基Data").Range("A1:Aj1000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:l2"), CopyToRange:=Range("p1:Ay1"), Unique:= _ False 'Range("N2").Select 'ActiveCell.FormulaR1C1 = "=SUBTOTAL(3,R2C16…

Power Automate Desktop サンプル

1. フォルダ内のファイルを一覧表示して、名前を表示するplaintextコピーする1. 「フォルダーの内容を取得」アクションを使用して、指定したフォルダー内のファイル一覧を取得します。2. 「繰り返し (各アイテムで)」アクションを使用して、取得したファイルの名前を一つずつ表示します。詳細な流れ: 「フォルダーの内容を取得」アクションでファイルパスを指定（例: C:\Users\YourName\Documents\）。「繰り返し」アクション内で、各ファイルの名前を「メッセージボックス」アクションを使って表示します。 2. Excelファイルの読み取りと書き込みplaintextコピーする1…

ファイル拡張子が .xlsm 以外の保存されていないワークブックを閉じる

Sub CloseWithoutSaving() Dim wb As Workbook ' 開いているすべてのワークブックを確認 For Each wb In Application.Workbooks ' ワークブックが保存されていない場合、保存せずに閉じる If wb.Path = "" Then wb.Saved = True ' 保存済みとして扱う wb.Close False ' 保存せずに閉じる Else ' 保存されている場合、拡張子を確認 If LCase(Right(wb.Name, 5)) <> ".xlsm" Then wb.Close False ' 保存せずに閉じる …

アクティブなワークブックを選択できるようにポップアップを表示

Sub CopyDataFromOtherWorkbook() Dim wbSource As Workbook Dim wsSource As Worksheet Dim wbDest As Workbook Dim wsDest As Worksheet Dim searchText As String Dim lastRow As Long Dim i As Long Dim destRow As Long Dim fileName As String ' アクティブワークブックを取得 Set wbDest = ActiveWorkbook Set wsDest = wbDest.Act…

指定条件のExcelブックをアクティブなシートとして選択

Sub CopyDataFromOtherWorkbook() Dim wbSource As Workbook Dim wsSource As Worksheet Dim wbDest As Workbook Dim wsDest As Worksheet Dim searchText As String Dim lastRow As Long Dim i As Long Dim destRow As Long Dim fileName As String ' 「ABC」という文字列を含む読み取り専用のワークブックを検索 For Each wbSource In Workbooks ' 読み…

アクティブなブック名とシート名をメッセージボックスで表示

Sub GetActiveWorkbookAndSheet() Dim wbActive As Workbook Dim wsActive As Worksheet ' アクティブなブックを取得 Set wbActive = ActiveWorkbook ' アクティブなシートを取得 Set wsActive = wbActive.ActiveSheet ' アクティブなブック名とシート名をメッセージボックスで表示 MsgBox "アクティブなブック: " & wbActive.Name & vbCrLf & "アクティブなシート: " & wsActive.NameEnd Sub

アクティブシートへ転記

Sub CopyDataFromOtherWorkbook() Dim wbSource As Workbook Dim wsSource As Worksheet Dim wbDest As Workbook Dim wsDest As Worksheet Dim filePath As String Dim searchText As String Dim lastRow As Long Dim i As Long ' 既に開いているExcelファイルの名前を指定（"アクティブシートへ転記.xlsm"） filePath = "アクティブシートへ転記.xlsm" ' 必要に応じて変更 Se…

転記サンプル

Sub CopyDataFromOtherWorkbook() Dim wbSource As Workbook Dim wsSource As Worksheet Dim wbDest As Workbook Dim wsDest As Worksheet Dim filePath As String ' 別のExcelファイルのパスを指定 filePath = "C:\path\to\your\file.xlsx" ' ファイルパスを適宜変更 ' アクティブなブックを取得 Set wbDest = ActiveWorkbook Set wsDest = wbDest.ActiveSheet…

既存CSVファイルの列指定してCSV再作成（事列 2, 4, 5 を抽出）

Dim objFSO, objFile, objTextFileDim inputCSVPath, outputCSVPathDim line, fields, newCSVContentDim columnsToKeep, i ' 既存のCSVファイルのパスを指定inputCSVPath = "C:\path\to\your\input.csv" ' 元のCSVファイルのパスを入力outputCSVPath = "C:\path\to\your\output.csv" ' 新しいCSVファイルの保存先パスを入力 ' 保存する列番号（1-based index、例: 2列目、4列目、5列目を抽…

指定ExcelsheetのCSV出力 個別CSV化

Dim objFSO, objFolder, objFileDim objExcel, objWorkbook, objSheetDim folderPath, outputPath, targetFileNameDim lastRow, i, csvFilePathDim csvContent, formattedDateDim searchValue, userInput ' フォルダのパスを指定folderPath = "C:\path\to\your\folder\" ' Excelファイルが格納されているフォルダのパスを入力outputPath = "C:\path\to\outpu…

指定ExcelsheetのCSV出力

Dim objFSO, objFolder, objFileDim objExcel, objWorkbook, objSheetDim folderPath, outputPath, targetFileNameDim lastRow, i, csvFilePathDim csvContent, formattedDateDim searchValue, userInput ' フォルダのパスを指定folderPath = "C:\path\to\your\folder\" ' Excelファイルが格納されているフォルダのパスを入力outputPath = "C:\path\to\outpu…

YYYYMMDD文字→日付変換

Sub ConvertToDate() Dim cell As Range ' 処理前に設定を無効化appSet ' セルが選択されていない場合に情報メッセージを表示 If Selection.Count = 1 And IsEmpty(Selection) Then MsgBox "変換したいセル範囲を選択してください。", vbInformation, "情報" ' 設定を元に戻す appReset Exit Sub End If ' 選択範囲内の各セルに対して処理を実行 For Each cell In Selection If IsNumeric(cell.Value) And Len…

別フォルダーからの複数転記 事例

Sub DataTransfer() ' 各ブックのパスを指定 Dim templatePath As String Dim resultPath As String Dim unsetPath As String Dim newBook As Workbook Dim templateBook As Workbook Dim resultBook As Workbook Dim unsetBook As Workbook Dim newFileName As String Dim folderPath As String Dim latestFileNumber As Long Dim fi…

汎用カレンダー 縦一列版

Sub CreateYearCalendar() Dim year As Integer Dim month As Integer Dim firstDay As Date Dim lastDay As Date Dim currentDay As Date Dim row As Integer Dim col As Integer Dim i As Integer Dim monthOffset As Integer Dim startRow As Integer Dim startCol As Integer ' ユーザーに年を指定させるポップアップ year = InputBox("カレ…

カレンダー2025年土日祝日のみ

Sub ExtractWeekendAndHolidays() Dim year As Integer Dim month As Integer Dim firstDay As Date Dim lastDay As Date Dim currentDay As Date Dim currentRow As Integer Dim i As Integer Dim holidayList As Collection Dim holidayDate As Date Dim holidayName As String ' 年を指定 year = 2025 ' 例: 2025年 ' 祝日リストを作成…

エクセルのキャッシュデータや不要な情報を一度に削除

Sub ClearExcelCache() Dim ws As Worksheet Dim pt As PivotTable Dim n As Name Dim conn As WorkbookConnection ' ピボットテーブルのキャッシュを削除 For Each ws In ThisWorkbook.Worksheets For Each pt In ws.PivotTables pt.PivotCache.Clear Next pt Next ws ' 名前付き範囲で#REF!が含まれているものを削除 For Each n In ThisWorkbook.Names If InSt…

外部データ接続を参照しているセルの情報をテキストファイル（.txt）に保存する

Sub ExportCellsWithDataConnectionsToTextFile() Dim ws As Worksheet Dim cell As Range Dim conn As WorkbookConnection Dim filePath As String Dim fileNum As Integer Dim externalConnections As Boolean ' テキストファイルの保存先とファイル名 filePath = Application.GetSaveAsFilename(FileFilter:="Text Files (*.txt), *.txt", …

スクリーンショット デスクトップへ保存

Option Explicit Dim WSDim time Set WS = CreateObject("WScript.Shell") ' MSPaintを起動WS.Run "mspaint.exe" ' Paintが完全に起動するまで待機 (1秒に増加)WScript.Sleep 1000 ' 現在のタイムスタンプを作成time = Replace(Replace(Replace(Now,"/","")," ",""),":","") ' クリップボードの内容を貼り付けWS.SendKeys "^v" ' トリミングのコマンド (Ctrl+Shift+X)を送信WS.SendKeys "…

セル内容置換

Sub セル内容置換() Dim targetCell As Range Dim resultText As String Dim findText, findText2 As String Dim replaceText, replaceText2 As String ' 置き換えたい元のセル（A1）を指定 Set targetCell = Range("A1") ' セルN1に記載されている置き換え対象文字列 findText = "＃1" findText2 = "＃2" ' セルN2に記載されている置き換え後の文字列 replaceText = Range("N1").Value re…

B列の最終行で印刷範囲を指定する

Sub B列の最終行で印刷範囲を指定する() Dim ws As Worksheet Dim lastRow As Long ' 対象のシートを設定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更 ' B列の最終行を取得 lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row ' 印刷範囲を指定（A1からB列の最終行まで） ws.PageSetup.PrintArea = "A1:Z" & lastRow ' 印刷プレビューを表示（任意） ws.PrintPreviewEnd Sub

転記して新規ブックを保存する

Sub 転記して新規ブックを保存する() Dim newWorkbook As Workbook Dim newSheet As Worksheet Dim templateWorkbook As Workbook Dim sourceSheet As Worksheet Dim templateFilePath As String Dim newFilePath As String Dim todayDate As String Dim lastRow As Long ' 元のシート（ThisWorkbook）の1行目から転記 Set sourceSheet = ThisWorkbook.S…

印刷設定を変更する

Sub 印刷設定を変更する() Call 文字列を90度回転する Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更してください With ws.PageSetup ' 印刷の向きを横向きに設定 .Orientation = xlLandscape ' ページに合わせて印刷 .FitToPagesWide = 1 .FitToPagesTall = 1 ' ヘッダーにブック名とシート名を設定 .LeftHeader = "&""Meiryo,Bold""&20 " & ThisWorkbook.Name …

Accessクエリからのオラクル検索

Sub OracleODBCConnect() Dim conn As Object Dim rs As Object Dim sql As String Dim dsn As String Dim user As String Dim password As String Dim fieldNames As String Dim fieldValues As String Dim i As Integer ' 接続情報 dsn = "Your_DSN_Name" ' DSN (ODBCデータソース名) user = "your_username" ' ユーザー名 password = "yo…

保存先を2カ所設定

Sub GetDataFromAccessAndSave() ' 変数の定義 Dim conn As Object Dim rs As Object Dim connString As String Dim query As String Dim newWb As Workbook Dim newWs As Worksheet Dim thisWs As Worksheet Dim desktopPath As String Dim filePath As String ' Accessデータベースへの接続文字列 (適切に設定してください) connString = "Provider=Mic…

Outlook送信前に確認メッセージを表示

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim response As Integer response = MsgBox("本当にこのメールを送信しますか？", vbYesNo + vbQuestion, "送信確認") If response = vbNo Then Cancel = True ' 送信をキャンセル End IfEnd Sub

添付ファイルがZIPファイルの場合に自動的にパスワードを送信するようにする

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim attachment As Object Dim strTo As String Dim objMail As Object Dim password As String Dim fileExtension As String Dim hasZipAttachment As Boolean Dim userResponse As Integer ' 添付ファイルの有無を確認 hasZipAttachment = False strTo = …

vbsでおしゃべりさせる

Option ExplicitDim voiceSet voice = CreateObject("sapi.SpVoice") voice.Rate = 3 '-10～10の範囲で指定voice.Volume = 100 '0～100の範囲で指定 voice.Priority = 0voice.Speak "こんにちは、私はあなたのコンピュータです。"Set voice = Nothing

Accessクエリを実行して、Oracleデータベースからデータを取得

Sub ConnectToOracleAndRunAccessQuery() Dim conn As Object Dim rs As Object Dim dbPath As String Dim connStr As String Dim sql As String Dim ws As Worksheet Dim i As Integer ' Excelシートの設定 Set ws = ThisWorkbook.Sheets("Sheet1") ws.Cells.Clear ' シートの内容をクリア ' Accessデータベースのパスを指定 dbPath = "C:\path\to\your…

ファイルダイアログの利用

Sub OpenFileDialog() Dim dialog As FileDialog Set dialog = Application.FileDialog(msoFileDialogFilePicker) ' デスクトップを最初に開く dialog.InitialFileName = Environ("USERPROFILE") & "\Desktop\" ' 指定フォルダを最初に開く dialog.InitialFileName = "Z:\Work\" ' ダイアログを表示 If dialog.Show = -1 Then MsgBox "選択されたファイル: " & dialog…

Excel項目 横方向のセル値の情報を絞り込む

横方向のセル値の情報を絞り込む ctl＋\(エンマーク) 指定範囲内のセル値以外を選択ctl＋0(ゼロ) 選択列の非表示

指定フォルダ内にエクセルbookを新規作成時、連番で作成

Sub ファイル名連番作成()Sub CreateNewWorkbookWithIncrementedName() Dim folderPath As String Dim fileName As String Dim newFileName As String Dim maxNum As Long Dim file As Object Dim fso As Object Dim i As Long ' フォルダーのパスを指定（例：C:\Users\yourname\Documents\ExcelFiles） folderPath = "C:\YourFolderPath\" ' FileSy…

セルの値を他のシートに転記

Sub CopyDataToAnotherSheet() Dim sourceWorkbook As Workbook Dim sourceSheet As Worksheet Dim destinationSheet As Worksheet Dim sourceFilePath As String ' ファイル選択ダイアログを表示して、ファイルパスを取得 sourceFilePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "ファイルを選択") ' キャンセルが押された場合、…

特定の文字列を検索して強調表示

Sub HighlightText() Dim cell As Range Dim searchText As String ' ユーザーに検索したい文字列を入力してもらう searchText = InputBox("検索したい文字列を入力してください", "文字列の検索") ' 入力が空でない場合に処理を実行 If searchText <> "" Then For Each cell In ActiveSheet.UsedRange If InStr(cell.Value, searchText) > 0 Then cell.Interior.Color = RGB(255, 255, …

セル内の前後のスペースや改行を削除

Sub TrimSpacesAndNewlines() Dim cell As Range For Each cell In Selection ' セルの前後のスペースと改行（Chr(10)）を削除 cell.Value = Trim(Replace(cell.Value, Chr(10), "")) Next cellEnd Sub

フォルダの選択ダイアログを表示する

Sub SelectFolder() Dim folderPath As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then ' ユーザーが「OK」をクリックした場合 folderPath = .SelectedItems(1) MsgBox "選択したフォルダ: " & folderPath End If End WithEnd Sub

指定した条件に基づいてセルを強調表示する

Sub HighlightCells() Dim cell As Range For Each cell In Range("A1:A10") If cell.Value > 50 Then cell.Interior.Color = RGB(255, 0, 0) ' 赤色 End If Next cellEnd Sub

ワークシートのコピー

Sub CopySheet() ActiveSheet.Copy After:=Sheets(Sheets.Count)End Sub

セル範囲をループして値を変更する

Sub LoopCells() For i = 1 To 5 Cells(i, 1).Value = "Item " & i Next iEnd Sub

セルに値を入力する

Sub EnterValue() Range("A1").Value = "Excel VBA"End Sub

メッセージボックスを表示する

Sub ShowMessage() MsgBox "Hello, World!"End Sub

分解して展開する Select Caseを利用する場合

Sub 分解して展開する() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim num As String Dim startCol As Long Dim j As Long Dim digit As String Dim integerPart As String Dim decimalPart As String Dim numLength As Long Dim decimalLength As Long ' ワークシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を…

分解して展開する

Sub 分解して展開する() ’条件:A列の数値⇒1億はG列～展開とする 'lastRow → lastR: 最終行の変数名を lastR に短縮。'num → n: 数値を格納する変数を n に短縮。'startCol → sCol: 開始列を指す変数名を sCol に短縮。'digit → dgt: 各桁を格納する変数名を dgt に短縮。'integerPart → intP: 整数部分の変数名を intP に短縮。'decimalPart → decP: 小数部分の変数名を decP に短縮。'numLength → nLen: 整数部分の桁数を表す変数名を nLen に短縮。'dec…

【自作関数版】Excelのセル文字分割

'//自作関数版 =MID(SplitText1(A1), 1, 1) Function SplitText1(inputStr As String) As String Dim cleanStr As String ' 数字の場合は小数点を除去 If IsNumeric(inputStr) Then cleanStr = Replace(inputStr, ".", "") ' 小数点を除去 Else cleanStr = inputStr ' 文字列の場合、そのまま End If ' 文字列を1文字ずつ分解して返す SplitTextWithoutDecimal = cleanStrEnd…

Excelセル値の分解

Sub セル値の分解() Dim str As String Dim i As Integer Dim lastRow As Long Dim rowNum As Long Dim cleanStr As String ' A列の最終行を取得 lastRow = Cells(Rows.Count, 1).End(xlUp).Row ' A列の各セルを処理 For rowNum = 1 To lastRow ' A列のセルの内容を取得 str = Cells(rowNum, 1).Value ' 数字の場合、小数点を除去 If IsNumeric(str) Then ' 小数点を除去する cle…

Oracle ODBCドライバの接続ダイアログに自動的接続

Sub Oracle ODBCドライバの接続() ' 変数の宣言 Dim conn As Object Dim connectionString As String Dim userID As String Dim password As String Dim tnsService As String Dim odbcDriver As String ' シートからユーザーID とパスワードを読み取る（例: シート1のA1とB1セル） userID = ThisWorkbook.Sheets("Sheet1").Range("A1").Value password = ThisWorkbook…

条件付き書式を利用して検索

Sub日付による条件判断() Dim cell As Range Dim referenceDate As Date Dim oneWeekBefore As Date Dim targetRange As Range Dim searchRange As Range Dim foundCell As Range ' 検索する範囲（例：B1:B10）を指定 Set searchRange = Range("B1:B10") ' 今日の日付を基準日として設定 referenceDate = Date ' 今日の日付を基準に設定 ' 検索範囲内で基準日を検索 Set foundCell = sea…

ExcelからAccess抽出(コード見直し版)

Sub ExcelからAccess抽出() Dim accessApp As Object Dim accessDbPath As String Dim queryName As String Dim conn As Object Dim connectionString As String Dim userName As String Dim password As String Dim odbcDSN As String ' Excelシートからユーザー名とパスワードを取得 userName = ThisWorkbook.Sheets("Sheet1").Range("A1").Value…

text復号化（暗号化の読み取りのみ）

Sub text復号化() Dim fs As Object Dim textFile As Object Dim encryptedText As String Dim plainText As String ' 暗号化されたファイルを読み込む Set fs = CreateObject("Scripting.FileSystemObject") Set textFile = fs.OpenTextFile("C:\path\to\your\encrypted_credentials.txt", 1) encryptedText = textFile.ReadAll textFile.Clo…

text暗号化（簡易）

Sub text暗号化() Dim fs As Object Dim textFile As Object Dim plainText As String Dim encryptedText As String ' ユーザー名とパスワード Dim OracleUsername As String Dim OraclePassword As String OracleUsername = "yourUsername" OraclePassword = "yourPassword" ' ユーザー名とパスワードを1つの文字列にまとめる plainText = OracleUsername & vbC…

列に各行の最後の非空セルの値を転記

Sub Z列に各行の最後の非空セルの値を転記() Dim rng As Range Dim C, cell As Range Dim lastNonEmptyCell As Range Dim inputRange As Range ' ユーザーにセル範囲を指定させるための InputBox を表示 On Error Resume Next Set inputRange = Application.InputBox("セル範囲を指定してください。例：A1:E10", "セル範囲選択", Type:=8) On Error GoTo 0 If inputRange Is Nothing Then…

検索結果を指定したひな形に転記してデスクトップに保存2

Sub 検索結果を指定したひな形に転記してデスクトップに保存2() ' Zフォルダにある対象のExcelファイル（ブック）を開く Dim sourceFolder As String sourceFolder = "C:\Users\YourUsername\Documents\Zフォルダ\" ' Zフォルダのパスを指定 Dim sourceWorkbook As Workbook Dim targetSheet As Worksheet Set sourceWorkbook = Workbooks.Open(sourceFolder & "ひな形ファイル.xlsx") ' ひな形のファイル名…

検索結果を指定のひな形に転記して保存

Sub 検索結果を指定のひな形に転記して保存() '配列バージョン ' Zフォルダにある対象のExcelファイル（ブック）を開く Dim sourceFolder As String sourceFolder = "C:\Users\YourUsername\Documents\Zフォルダ\" ' Zフォルダのパスを指定 Dim sourceWorkbook As Workbook Dim targetSheet As Worksheet Set sourceWorkbook = Workbooks.Open(sourceFolder & "対象のファイル.xlsx") ' 対象のファイル名を…

非表示セルは検索対象外にする場合

For j = 2 To lastRowTarget ' 指定ブックのA列を検索（ヘッダー行を除く） If wsTarget.Rows(j).Hidden = False Then ' 非表示の行を無視 If wsTarget.Cells(j, 1).Value = searchKey Then foundRow = j Exit For ' 一致した行が見つかったのでループを抜ける End If End IfNext j

罫線(実線のみ)

Sub 罫線() Dim ws As Worksheet Dim LastRow As Long Dim LastCol As Long Dim i As Long Dim RangeToFormat As Range ' シートを指定（例: シート1） Set ws = ThisWorkbook.Sheets("Sheet1") ' 最終行（データがある最後の行）を取得 LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 最終列（データがある最後の列）を取得 LastCol = ws.Cells(1, ws.Columns.Count…

リストの罫線(実線と点線)

Sub リストの罫線() Dim ws As Worksheet Dim LastRow As Long Dim LastCol As Long Dim i As Long Dim RangeToFormat As Range ' シートを指定（例: シート1） Set ws = ThisWorkbook.Sheets("Sheet1") ' 最終行（データがある最後の行）を取得 LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 最終列（データがある最後の列）を取得 LastCol = ws.Cells(1, ws.Columns.C…

エラーセルはスキップ処理

Sub SkipErrorCells() Dim ws As Worksheet Dim cell As Range Dim result As Variant ' シートの指定 (ここではActiveSheetを使っています) Set ws = ActiveSheet ' 範囲を指定 (例えばA1からA10まで) For Each cell In ws.Range("A1:A10") On Error Resume Next ' エラーが発生しても次の行に進む result = cell.Value * 2 ' 例: 数値に対して計算を行う (エラーが発生する可能性あり) If Err.Nu…

VBAの用途別、適切なデータ型種類ガイドライン 参考に。。。

VBAの用途別、適切なデータ型種類ガイドライン 参考に。。。 整数型: Integer: 小さな範囲の整数（-32,768 ～ 32,767）。 Long: 大きな整数（-2,147,483,648 ～ 2,147,483,647）。 浮動小数点型: Single: 浮動小数点数（精度が少し低い）。 Double: 高精度の浮動小数点数。 文字列型: String: 文字列データ（名前、住所など）。 論理型: Boolean: 真偽値（True または False）。 日付型: Date: 日付や時刻。 汎用型: Variant: あらゆる型のデータを格納可能。ただし、使用時には注意のこと。 …

A列、B列、C列を結合してキーにして転記

Sub 転記() Dim folderPath As String Dim fileName As String Dim wb As Workbook Dim isOpen As Boolean Dim tempWb As Workbook Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim lastRowSource As Long Dim lastRowTarget As Long Dim key As String Dim i As Long Dim matchRow As Long Dim cell As Range ' チェ…

転記先bookが開かれているかチェックしてから転記

Sub 転記() Dim folderPath As String Dim fileName As String Dim wb As Workbook Dim isOpen As Boolean Dim tempWb As Workbook Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim lastRowSource As Long Dim lastRowTarget As Long Dim key As String Dim i As Long Dim matchRow As Long Dim cell As Range ' チェ…

アクティブシートと別のブックのデータへ転記

Sub 転記() Dim folderPath As String Dim fileName As String Dim wbSource As Workbook ' アクティブブック Dim wsSource As Worksheet ' アクティブブックのシート Dim wbTarget As Workbook ' 指定したブック Dim wsTarget As Worksheet ' 指定したシート Dim lastRowSource As Long ' アクティブブックの最終行 Dim lastRowTarget As Long ' 指定ブックの最終行 Dim i As Long, j…

配列を使って、アクティブシートと別のブックのデータへ転記

Sub 配列による転記() Dim folderPath As String Dim fileName As String Dim wbSource As Workbook ' アクティブブック Dim wsSource As Worksheet ' アクティブブックのシート Dim wbTarget As Workbook ' 指定したブック Dim wsTarget As Worksheet ' 指定したシート Dim lastRowSource As Long ' アクティブブックの最終行 Dim lastRowTarget As Long ' 指定ブックの最終行 Dim i As Lo…

条件に一致したデータを元のシートの対応する行に上書き

Sub データ更新() Dim folderPath As String Dim fileName As String Dim wb As Workbook Dim ws As Worksheet Dim targetWs As Worksheet Dim tempWs As Worksheet Dim lastRow As Long Dim targetRow As Long Dim i As Long Dim j As Long Dim conditionColumn As Long Dim conditionValue As Variant Dim foundRow As Long ' …

オートフィルター解除

’～実例コード～ ' フィルターがかかっている場合、フィルターを解除 If wsData.AutoFilterMode Then wsData.ShowAllData ' フィルター解除 End If

AutoHotkey（AHK）でDisplay切替

#M:: { if (IsUpDisplayPrimary) { ; 下ディスプレイをメインに設定 Run, C:\_cmd\multimonitortool-x64\MultiMonitorTool.exe /SetPrimary 2 IsUpDisplayPrimary := false } else { ; 上ディスプレイをメインに設定 Run, C:\_cmd\multimonitortool-x64\MultiMonitorTool.exe /SetPrimary 1 IsUpDisplayPrimary := true } Sleep, 1000 ; 1秒待機 return}