Sub 転記() Dim LastRow As Long Dim i As Long ' Sheet1の最終行を取得 LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row ' データ転記 For i = 2 To LastRow ' 1行目はヘッダーとしてスキップ ' Sheet1からSheet2へ値のみ転記 Sheets("Shee…

Sub CreatePivotTableWithPrompt() Dim ws As Worksheet Dim pt As PivotTable Dim pc As PivotCache Dim rngData As Range Dim rngDest As Range Dim response As VbMsgBoxResult ' データ範囲を指定します。適切に変更してください。 Set ws = ThisWorkboo…

Sub CreatePivotTableWithFormat() Dim ws As Worksheet Dim pt As PivotTable Dim pc As PivotCache Dim rngData As Range Dim rngDest As Range ' データ範囲を指定します。適切に変更してください。 Set ws = ThisWorkbook.Worksheets("Sheet1") Set rngD…

Sub CopyData1() Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As Long ' ソースシート（コピー元のシート）とターゲットシート（コピー先のシート）を設定 Set sourceSheet = ThisWorkbook.Sheets("Sheet1") Set targetSheet = …

Sub 編集結果を転記する()'売上見込み編集 Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As Long Dim i As Long Dim targetRow As Long Dim targetColumn As Long Dim sourceColumns As Long '編集結果シート初期化 Sheets("編集…

Option ExplicitSub sheet初期化() Columns("A:H").Select Selection.ClearContents Range("A1").SelectEnd SubSub 売上編集結果()'出品した商品 販売利益データのデータから編集 Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As…

Sub CreateTableOfContents() Dim ws As Worksheet Dim tocSheet As Worksheet Dim rowNum As Integer Dim sheetNum As Integer ' 新しいシートを作成して目次を作成 Set tocSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheet…

Option ExplicitSub 最短納期抽出() Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim lastRowSource As Long Dim lastRowDest As Long Dim sourceRange As Range Dim destRange As Range Dim dict As Object Dim key As Variant Dim rowNum A…

Sub AddSheetWithDate() Dim ws As Worksheet Dim newSheet As Worksheet Dim templateSheet As Worksheet Dim sheetName As String Dim templateFound As Boolean ' 今日の日付をMMDD形式で取得 sheetName = Format(Date, "mmdd") ' すでに同じ名前のシート…

Dim FilePathFilePath = "D:\ThinkpadMark3\自学\filename変更_bat類\.xlsm\繰り返しCopy.xlsm" Dim appSet app = CreateObject("Excel.Application")app.Visible = trueapp.Workbooks.Open FilePathapp.Run "Module1.繰り返し" app.DisplayAlerts = False a…

Sub 昨日の日付をセルに出力() Dim 昨日 As Date Dim yyyymmdd As String ' 昨日の日付を計算 昨日 = Date - 1 ' yyyymmdd形式で文字列に変換 yyyymmdd = Format(昨日, "yyyymmdd") ' セルA1に文字列を出力 Sheets("sheet1").Range("A1").Value = yyyymmddEnd…

Sub ExportToExcelAndCompress() Dim xlApp As Object Dim xlBook As Object Dim rs As Recordset Dim strSQL As String Dim filePath As String ' エクスポートするデータのクエリを指定 strSQL = "SELECT * FROM YourTableName" ' データをレコードセット…

Sub ExportAndCompressData() Dim rs As Recordset Dim db As Database Dim strSQL As String Dim exportPath As String Dim zipPath As String Dim zipFileName As String Dim shellApp As Object ' エクスポートするデータのクエリを指定 strSQL = "SELECT…

Sub ExportDataInBatches() Dim rs As Recordset Dim db As Database Dim strSQL As String Dim batchCount As Integer Dim batchSize As Integer Dim recordCount As Long Dim i As Integer ' バッチサイズとエクスポートするデータの数を設定 batchSize = …

Private Sub ExcelExport() '変数宣言Dim filePath As String 'Excelエクスポート先のファイルパス ’filePath = "D:\保存先\" & "Export_" & Format(Date, "yymmdd") & ".xlsx" ' Excelファイルを保存するデスクトップのパスを取得 filePath = Environ("USER…

Option Explicit Sub CreateSQLReview() Dim conn As Object Dim rs As Object Dim strSQL As String Dim strOutput As String Dim i As Integer ' Access データベースへの接続 Set conn = CreateObject("ADODB.Connection") conn.Open "Provider=Microsoft…

'//ordersテーブルから顧客ごとの注文数を計算し、その注文数が3以上の顧客のみを抽出 SELECT customer_id, COUNT(*) AS order_countFROM ordersGROUP BY customer_idHAVING COUNT(*) >= 3; '//各部署の平均給与を計算し、平均給与よりも高い給与を持つ部署…

'//サブクエリ サンプル-----------In(SELECT フィールド名1 FROM Q_名称 WHERE( フィールド名2 = 条件1 And フィールド名3 = 条件2 ) OR( フィールド名2 = 条件3 And フィールド名3 = 条件4 ) OR( フィールド名2 = 条件5 And フィールド名3 = 条件6 ) OR( …

Sub Excel→Accessデータ抽出2() Dim AccessApp As Object Dim AccessDb As Object Dim AccessQuery As Object Dim AccessRecordset As Object Dim ExcelApp As Object Dim ExcelSheet As Object Dim AccessPath As String Dim i As Long ' Accessデータベー…

Sub Excel→Accessデータ抽出() Dim AccessPath As String Dim AccessQuery As String Dim ConnectionString As String Dim Conn As Object Dim RS As Object Dim ExcelApp As Object Dim ExcelSheet As Object Dim i As Long Dim paramValue1 As String Dim …

Sub 最新単価抽出() Dim wsData As Worksheet Dim wsOutput As Worksheet Dim lastRow As Long Dim partNumCol As Long, dimCol As Long, bcCol As Long, dateCol As Long, priceCol As Long Dim key As Variant Dim priceDict As Object Dim maxDateDict As…

Sub ExtractLatestPrice() Dim ws As Worksheet Dim lastRow As Long Dim partNumbers As Variant Dim uniquePartNumbers As Variant Dim partNumber As Variant Dim i As Long Dim maxDate As Date Dim latestPrice As Double Dim outputRow As Long ' デー…

Sub ExtractLatestPrices4() Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim lastRow As Long Dim partNumbers As Object Dim key As String Dim maxDate As Date Dim latestPrice As Double Dim newData() As Variant Dim i As Long Dim newRow …

Sub シート連番() Dim ws As Worksheet Dim i As Integer i = 1 For Each ws In ThisWorkbook.Sheets If Left(ws.Name, 2) = "最新" Then ws.Name = Left(ws.Name, 4) & Format(i, "00") i = i + 1 End If Next wsEnd Sub

Sub日付け変更 () Dim cell As Range Dim originalDate As String Dim convertedDate As String ' 変換したいセルの範囲を指定 For Each cell In Selection ' セルの値を取得 originalDate = cell.Value ' yyyymmdd形式からyyyy/mm/dd形式に変換 If Len(orig…

Sub フォルダ内の全シート1を取りまとめる() Dim フォルダパス As String Dim 対象ファイル As String Dim 対象ブック As Workbook Dim 一時ブック As Workbook Dim シート As Worksheet Dim 合成シート As Worksheet Dim 最終行 As Long Application.Screen…

Option Explicit Sub フォルダ内の全集計ファイルを取りまとめる() Dim フォルダパス As String Dim 対象ファイル As String Dim 対象ブック As Workbook Dim 一時ブック As Workbook Dim シート As Worksheet Dim 合成シート As Worksheet Dim 最終行 As Lo…

Sub ExtractDataFromAccess() Dim conn As Object ' ADO Connection Dim rs As Object ' ADO Recordset Dim strConn As String Dim strSQL As String Dim i As Integer Dim j As Integer ' Access データベースへの接続文字列を設定（IDとパスワードあり） s…

Sub HighlightLastNonEmptyCell() Dim rng As Range Dim cell As Range Dim lastNonEmptyCell As Range Dim inputRange As Range ' ユーザーにセル範囲を指定させるための InputBox を表示 On Error Resume Next Set inputRange = Application.InputBox("セ…

Function rightcellvalue(rng As Range) As Variant Dim lastCell As Range Dim ws As Worksheet ' シートをアクティブにする（指定範囲がどのシートにあるかを確認） Set ws = rng.Worksheet ws.Activate ' 指定範囲内の最後のセルを取得 Set lastCell = rn…