条件に応じてコピー

Sub CopyFormulasBasedOnCriteria() Dim wsSource As Worksheet Dim wsTemplate As Worksheet Dim lastRow As Long Dim i As Long Dim copyRow As Long Dim pasteRow As Long ' シートをセットアップ Set wsSource = ThisWorkbook.Sheets("Data") Set wsTemplate = ThisWorkbook.Sheets("ひな形") ' 最終行を取得 lastRow = wsSource.Cells(wsS…

判別して記入

Sub 判別して記入() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lastRow1 As Long Dim lastRow2 As Long Dim keyRange As Range Dim cell As Range Dim keyArray() As Variant Dim keyIndex As Long Dim labels() As String Dim labelIndex As Long Dim label As String ' シート1とシート2を設定 Set ws1 = ThisWorkbook.Sheets("Shee…

コピー転記してから色付け

Sub コピー転記してから色付け() Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim wsKeywords As Worksheet Dim lastRowSource As Long Dim lastRowKeywords As Long Dim i As Long Dim j As Long Dim keyword As String ' Sheet1をソース、Sheet2を転記先、Sheet3をキーワードのシートに設定 Set wsSource = ThisWorkbook.Sheets("Sheet1") Set…

振分 (正規表現)

Sub UpdateDColumnWithRegex() Dim regex As Object Dim lastRow As Long Dim i As Long ' 正規表現オブジェクトを作成 Set regex = CreateObject("VBScript.RegExp") ' パターンを設定 regex.IgnoreCase = True regex.Global = True ' 最終行を取得 lastRow = Cells(Rows.Count, "C").End(xlUp).Row ' ループして条件に基づいてD列を更新 For i = 1 To lastRow ' 文字列か…

2つのKEYを比較し、お互いに存在しないKEYを別シートに抽出する

Sub 比較と記載1() ’Dictionaryにてremoveメソッド利用(ないものを削除パターン) Dim ws As Worksheet Dim lastRow1, lastRow2 As Long Dim aRange As Range, cRange As Range Dim aValue As Variant, cValue As Variant Dim compareColumnA As Range, compareColumnC As Range Dim resultDictA As Object, resultDictC As Object Dim i As Long ' 対…

ヒットする項目を抽出する

Sub TransferData() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lastRow1 As Long Dim lastRow2 As Long Dim i As Long Dim j As Long Dim keyA As String Dim keyB As String Dim matchFound As Boolean ' Sheet1とSheet2を設定 Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("Sheet2") ' Shee…

指定された日付から60日後の日付を計算

Sub 前日の日付を計算してセルに入力() Dim 検索日 As Date Dim 前日 As Date Dim 後日 As Date Dim フォーマット済み日付 As String Dim 休みの日 As Range ' セルA1に入力された日付を取得（ここではA1を例示しています） 検索日 = Range("A1").Value ' 休みの日をシート2のA列から取得 Set 休みの日 = Sheets("Sheet2").Range("A:A") ' 検索日の前日を計算 前日 = WorksheetFunction.WorkDay(検索日, -1, 休みの日) ' 検索日の後60日を計算…

ワークデイ関数を使って指定した日付の前日を計算

Sub 前日の日付を計算してセルに入力() Dim 検索日 As Date Dim 前日 As Date Dim フォーマット済み日付 As String Dim 休みの日 As Range ' セルA1に入力された日付を取得（ここではA1を例示しています） 検索日 = Range("A1").Value ' 休みの日をシート2のA列から取得 Set 休みの日 = Sheets("Sheet2").Range("A:A") ' 検索日の前日を計算 前日 = Application.WorksheetFunction.WorkDay(検索日, -1, 休みの日) ' yyyymmdd形式に日付を…

指定年、月と前後月 土日検索

Sub ExtractWeekendAndHolidayDatesByMonth(yearToSearch As Integer, monthToSearch As Integer) Dim startDate As Date Dim endDate As Date Dim currentDate As Variant Dim ws As Worksheet Dim rowNum As Long Dim holidayDates As Variant Dim i As Integer ' 新しいシートを作成します Set ws = ThisWorkbook.Sheets.Add(After:=…

毎月の土曜日と日曜日 抽出

Sub ExtractWeekendDates() Dim startDate As Date Dim endDate As Date Dim currentDate As Date Dim ws As Worksheet Dim rowNum As Long ' 新しいシートを作成します Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ws.Name = "WeekendDates" ' シートの名前を設定します ' ヘッダーを設定します ws.Range("A1"…

日本の休日を考慮して土曜日と日曜日を検索

Sub ExtractWeekendAndHolidayDatesByYear(yearToSearch As Integer) Dim startDate As Date Dim endDate As Date Dim currentDate As Date Dim ws As Worksheet Dim rowNum As Long Dim holidayDates As Variant Dim i As Integer ' 新しいシートを作成します Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbo…

クリア (列全体 EntireColumn)

Sub Sample() Range("B2:D5").EntireColumn.ClearEnd Sub

重複削除

Sub Sample() Range("A:C").RemoveDuplicates(Array(1, 2, 3))End Sub

条件 振り分け2

Sub UpdateDColumnWithRegex555() Dim regex As Object Dim lastRow As Long Dim i As Long '参照設定 Microsoft VBScript Regular Expressions 5.5 ' 正規表現オブジェクトを作成 Set regex = CreateObject("VBScript.RegExp") ' パターンを設定 regex.IgnoreCase = True regex.Global = True ' 最終行を取得 lastRow = Cells(Rows.Count, "C").End(xlUp)…

条件 振り分け

Sub UpdateDColumn() Dim lastRow As Long Dim i As Long ' 最終行を取得 lastRow = Cells(Rows.Count, "C").End(xlUp).Row ' ループして条件に基づいてD列を更新 For i = 2 To lastRow If InStr(1, Cells(i, "C").Value, "AAA") > 0 And InStr(1, Cells(i, "C").Value, "Z") > 0 Then Cells(i, "D").Value = "A111" ElseIf InStr(1, Cells(i, "C"…

sakuracolor kuro-2.col

'//sakuracolor kuro-2.col ; テキストエディタ色設定 Ver3 [SakuraColor]C[BRC]=1,1,ffff84,202020,0C[CAR]=1,0,ff8080,3a3a3a,0C[CBK]=0,0,f2f8f8,0e1616,0C[CMT]=1,0,cc9b6a,202020,0C[CTL]=0,0,c6c6c6,202020,0C[CVL]=0,0,ffc184,3a3a3a,0C[DFA]=0,0,202020,ffc184,0C[DFC]=0,0,202020,c0fdbd,0C[DFD]=0,0,202020,f2f8f8,0C[EBK]=0…

時間計測 サンプル

Sub Main() Dim executionTime As Double executionTime = MeasureExecutionTime() MsgBox "計測完了" & vbLf & "実行時間は" & Format(executionTime, "0.000秒") & "でした"End SubFunction MeasureExecutionTime() As Double Dim startTime As Double startTime = Timer ' ここに測定したい処理を挿入 Call AddSheetNamesToLastColumn2 MeasureExec…

重複削除し、抽出

Sub RemoveDuplicatesAndTransfer() Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As Long Dim i As Long Dim keyColumn As Range Dim keyRange As Range Dim uniqueKeys As Collection Dim key As Variant ' ソースシートとターゲットシートを設定 Set sourceSheet = ThisWorkbook.Sheets("Sheet1") ' ソースデータのシート…

処理を分岐

Sub MessagePrompt() Dim response As VbMsgBoxResult ' メッセージボックスを表示し、ユーザーからの応答を取得します response = MsgBox("処理を続行しますか？", vbYesNo + vbQuestion, "確認") ' ユーザーがYesを選択した場合の処理 If response = vbYes Then MsgBox "処理を続行します。" ' ここにYesを選択した場合の処理を記述します Else ' ユーザーがNoを選択した場合の処理 MsgBox "処理を中止します。" ' ここにNoを選択した場合の処理を記述します…

time計測

'time計測Dim ST As DoubleST = Timer '処理時間の取得Debug.Print Timer - STMsgBox "取得が完了しました" & vbLf & "実行時間は" & Format(Timer - ST, "0.000秒") & "でした" '//-------------------- Debug.Print Now() & Right(Format(Timer, "0.00"), 3)Debug.Print Format(Now(), "YYYY/MM/DD HH:MM:SS") & Right(Format(Timer, "0.00"), 3)Debu…