Option Explicit ' ドロップアウトするフォルダを指定しますConst sourceFolder = "Z:\Work\" ' 出力フォルダを指定しますConst outputFolder = "Z:\Work\" Dim objFSO, objFolder, objFileDim shell, newName, fileName ' File System Object を作成しますS…

Sub InsertTodayDate() Range("A1").Value = Format(Date, "YYYYMMDD")End Sub

Sub 罫線案()Dim st As WorksheetSet st = Worksheets("sheet1") Dim myRegion As VariantmyRegion = Range("A1").CurrentRegion Dim z, x, j As LongFor j = LBound(myRegion, 2) To UBound(myRegion, 2) z = st.Cells(Rows.Count, j).End(xlUp).rowx = st.…

Sub WriteFileNamesToSheet() ' フォルダのパスを指定 Dim folderPath As String folderPath = "Z:\Work" ' 出力シートを指定 Dim outputSheet As Worksheet Set outputSheet = ThisWorkbook.Sheets("Sheet1") ' ファイル一覧を取得 Dim objFSO As Object Se…

' フォルダのパスを指定folderPath = "Z:\Work" ' 出力ファイルの保存場所とファイル名を指定 ’desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")outputFolderPath = "C:\Custom\Path"outputFileName = "output.txt" ' ファイル一覧を…

Option Explicit Private Tree As Worksheet, 作業sheet As Worksheet, 階層図 As WorksheetPrivate Treeの行末 As Long, 表示行 As Long Sub Tree図() Dim 行1 As Long, 行2 As Long, 行末 As Long Set Tree = Worksheets("Tree") Set 作業sheet = Workshee…

Option Explicit Private 親子 As Worksheet, 作業用 As Worksheet, 階層図 As WorksheetPrivate 親子の行末 As Long, 表示行 As Long Sub SwapColumnsAandB() Dim ws As Worksheet Dim lastRow As Long Dim temp As Variant Dim i As Long ' Set a referenc…

Sub ステータスバーに進捗表示() Dim i,r As Long r = 1000 ' 検索値 For i = 0 To r Application.StatusBar = "進捗状況：" & i & "/" & r & "(" & (i / r) * 100 & "%)" Next Application.StatusBar = False End Sub

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

Sub ExecutePassThroughQuery() ’Microsoft ActiveX Data Objects x.x Library Dim conn As ADODB.Connection Dim cmd As ADODB.Command Dim rs As ADODB.Recordset Dim connectionString As String Dim sqlQuery As String ' SQL Serverへの接続情報 connec…

’開発タブ￥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 ' ソースシートと宛先シート…