Option Explicit ’PERSONAL.XLSBのThisWorkbookへ保存 '// Excelのイベント検知Dim WithEvents x As Application '// PERSONAL.XLSBが開いたときPrivate Sub Workbook_Open() '// Excelアプリケーションのイベントを検知する Set x = ApplicationEnd Sub '//…

Sub ステータスバー1() Dim i As Long For i = 1 To 500 Application.StatusBar = i & "回目の処理をしています..." Next i Application.StatusBar = FalseEnd Sub Sub ステータスバー2() ThisWorkbook.Worksheets("Sheet1").Activate Application.Wait [Now…

'vba起動の経過時間、関数の宣言'Declare Function GetTickCount Lib "kernel32.dll" () As Long '←32bitDeclare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long '←64bit Sub 処理時間計測()stTimer = GetTickCount '//--測定する処理------ …

Sub 可視列連番()'可視列に対して連番 Dim r1, r2 As Range Dim i As Long Set r2 = ActiveSheet.UsedRange.Columns(1) Set r2 = r2.SpecialCells(xlCellTypeVisible) i = 0 For Each r1 In r2.Cells r1.Value = i i = i + 1 Next End Sub

’開発タブ￥Excelアドインから取り込み ’C:\Users\ユーザー名\AppData\Roaming\Microsoft\addins\自作関数.xlam Function IndexMatch(検索値 As Variant, 検索範囲 As Range, 戻り範囲 As Range) Set IndexMatch = WorksheetFunction.Index(戻り範囲, Worksh…

Option Explicit 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 …

Sub マトリクス表をデータリストに置き換える() Dim wsInput As Worksheet Dim wsOutput As Worksheet Dim inputRange As Range Dim outputRange As Range Dim i As Long, j As Long, k As Long ' マトリクス表があるシートと範囲を指定 Set wsInput = ThisW…

Sub A列項目の種類別に、B列項目を取りまとめる() Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim lastRow As Long Dim uniqueValues As Collection Dim cell As Range Dim key As Variant Dim result As String ' ソースシートと宛先シート…

Sub 各シートに新しい列を挿入して最終行までシート名を記載() Dim ws As Worksheet Dim lastRow As Long Dim newCol As Integer ' 各シートに対してループ For Each ws In Worksheets ' シートの最終行を取得 lastRow = ws.Cells(ws.Rows.Count, "A").End(x…

Sub 各シートにシート名をA1セルに記載() Dim ws As Worksheet ' 各シートに対してループ For Each ws In Worksheets ' 各シートのA1セルにシート名を記載 ws.Range("A1").Value = ws.Name Next wsEnd Sub

Sub アクティブブックのシートをまとめる() Dim ws As Worksheet Dim summarySheet As Worksheet Dim lastRowSummary As Long, lastRowSource As Long Dim lastCol As Long Dim sourceRange As Range, destinationRange As Range ' 新しいシートを作成 Set s…

Sub 比較と記載() Dim ws As Worksheet Dim lastRow1, lastRow2 As Long Dim aRange As Range, cRange As Range Dim aValue As Variant, cValue As Variant Dim bColumn As Range, dColumn As Range Dim i As Long ' 対象のシートを設定 Set ws = ThisWorkbo…

Option Explicit Sub GetDataFromAccessWithMultipleConditions() Dim conn As Object Dim rs As Object Dim ws As Worksheet Dim strSQL As String ' Accessデータベースへの接続 Set conn = CreateObject("ADODB.Connection") conn.ConnectionString = "Pr…

Sub CreatePivotTable() Dim wsData As Worksheet Dim wsPivot As Worksheet Dim rngData As Range Dim pvtTable As PivotTable Dim pvtField As PivotField ' データがあるワークシートを指定 Set wsData = Worksheets("Sheet1") ' シート名を適切に変更 ' …

Sub 抽出と取りまとめ() Dim ws原本 As Worksheet Dim ws結果 As Worksheet Dim dict As Object Dim lastRow As Long Dim i As Long Dim key As Variant ' シートの設定 Set ws原本 = ThisWorkbook.Sheets("Sheet1") ' オリジナルデータがあるシート名 Set w…

Sub HighlightAndConvertText() Dim ws As Worksheet Dim rng As Range Dim cell As Range Dim hasTarget As Boolean Dim convertedCount As Long ' 対象のシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切に変更 ' 対象の範囲を指定…

Sub SearchAccessQueryWithMultipleParameters() Dim conn As Object Dim rs As Object Dim strSQL As String Dim strConnection As String Dim accessDBPath As String Dim searchValue1 As Variant Dim searchValue2 As Variant Dim searchValue3 As Varia…

Option Explicit Sub CompareAndSaveData() Dim accessApp As Object Dim excelApp As Object Dim excelWorkbook As Object Dim accessTable As Object Dim excelWorksheet As Object Dim currentDate As String Dim newWorkbookPath As String ' Access デ…

Sub 比較処理マクロ() Dim ws1 As Worksheet, ws2 As Worksheet, diffWs As Worksheet, addWs As Worksheet, delWs As Worksheet Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long, k As Long Dim foundMatch As Boolean Dim currentTime As D…

Sub 選択メールの添付ファイル削除() Set myOlApp = CreateObject("Outlook.Application") Set myOlSel = myOlApp.ActiveExplorer.Selection If myOlSel.Count = 0 Then MsgBox "メールが選択されていません" Exit Sub End If If vbYes <> MsgBox(myOlSel.Co…

Sub SaveOutlookMessagesWithDifferentFilenames() Dim olApp As Object Dim olNamespace As Object Dim olFolder As Object Dim olItem As Object Dim strOutputFolder As String Dim fs As Object Dim outFile As Object Dim isSentByMe As Boolean ' Outl…

Outlookを開き、 「開発」タブを有効にする。 「Visual Basic」をクリックしてVBAエディタを開く。 「挿入」メニューから「モジュール」を選択して下記VBA貼り付け。 Sub RemoveAttachmentsFromSelectedEmails() Dim selectedItems As Selection Set selecte…

Sub KEY列の比較とリスト化() Dim ws1 As Worksheet, ws2 As Worksheet, wsResult As Worksheet Dim cell1 As Range, cell2 As Range Dim keyColumn As Integer Dim notFoundInSheet1 As String, notFoundInSheet2 As String Dim resultRow, resultRow2 As L…

Sub 環境変数を取得する()'コンピュータ名MsgBox "コンピュータ名は" & vbLf & Environ("COMPUTERNAME")'ユーザー名MsgBox "ユーザー名は" & vbLf & Environ("USERNAME")'テンポラリーフォルダのパスMsgBox "テンポラリーフォルダのパスは" & vbLf & Environ…

Sub 自動処理マクロcsv保存() ' 指定の時間に実行されるVBAコード ' 例: シート1の5行目以降のA、B、C、E、G、H列のデータをCSVとして保存 Dim FilePath As String Dim LastRow As Long Dim DataRange As Range Dim Today As Date Dim HeaderValue As Varian…

Sub データを検索して代入する_配列() Dim シート1 As Worksheet Dim シート2 As Worksheet Dim データ1 As Variant Dim データ2 As Variant Dim 結果 As Variant Dim i As Long, j As Long ' シートの参照 Set シート1 = Worksheets("Sheet1") ' シート名を…

Sub データを検索して代入する() Dim シート1 As Worksheet Dim シート2 As Worksheet Dim セル1 As Range Dim セル2 As Range Dim 検索値1 As String Dim 検索値2 As String Dim 結果セル As Range ' シートの参照 Set シート1 = Worksheets("Sheet1") ' シ…

Sub ImportDataFromPowerBI() Dim wbPowerBI As Workbook Dim wsPowerBIData As Worksheet Dim wsDestination As Worksheet ' Power BIからエクスポートしたExcelファイルを開く Set wbPowerBI = Workbooks.Open("Z:\Work\data.csv") ' Power BIデータが含ま…

Sub コメントの転記() Dim シート1 As Worksheet Dim シート2 As Worksheet Dim セル1 As Range Dim セル2 As Range Dim 対応項目が見つかった As Boolean ' シートの参照 Set シート1 = Sheets("Sheet1") ' シート名を適切に変更 Set シート2 = Sheets("She…

Sub 列のアイテムの違いを抽出1() Dim 対象範囲 As Range Dim シート As Worksheet Dim 抽出シート As Worksheet Dim セル As Range Dim 値 As Variant Dim 抽出範囲 As Range Dim 最終行 As Long ' 対象範囲を指定 Set シート = Sheets("Sheet1") ' シート…