Sub 最終行まで削除() Dim LastRow As Long 'A列の最終行を取得 LastRow = Cells(Rows.Count, 1).End(xlUp).Row '5行目から最終行までを一括削除 Range("A5:A" & LastRow).EntireRow.ClearContents End Sub

Sub リンク設定() Dim i As Long With ActiveSheet.Hyperlinks '5行目から最終行まで For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row 'B列にリンク設定、リンク先はD列 .Add Anchor:=Cells(i, 2), Address:=Cells(i, 4).value Next i End With End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("B2:C19")) Is Nothing Then Cancel = True Target.Formula = Date End If 'E列のセルをダブルクリックした場合 If Target.Column = 5 …

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' 特定のセル範囲でダブルクリックされた場合の処理 'A列をダブルクリックで時刻表示 If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then Target.value = Now …

Sub Sample3() Dim f As Object, cnt As Long cnt = 1 'A列に作成日時 Cells(1, 1) = "作成日時" 'B列にファイル名称 Cells(1, 2) = "ファイル名" 'C列にファイルサイズ Cells(1, 3) = "ファイルサイズ" Cells(1, 4) = "保存場所" With CreateObject("Script…

Sub ブック作成() Dim 元ブック As Workbook Dim 元シート As Worksheet Dim 対象シート As Worksheet Dim 新ブック As Workbook Dim ファイルパス As String ' 元のブックを設定 Set 元ブック = ThisWorkbook ' シート6のA1セルの値を取得 Dim 新ブック名 A…

Sub CreateFoldersBasedOnCellValue() Dim ParentFolderPath As String ParentFolderPath = ThisWorkbook.Path ' ファイルと同じディレクトリのパスを取得 Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("Sheet6") ' シート名を適切に変更してくだ…

Sub Sample3() Dim f As Object, cnt As Long cnt = 1 'A列に作成日時 Cells(1, 1) = "作成日時" 'B列にファイル名称 Cells(1, 2) = "ファイル名" 'C列にファイルサイズ Cells(1, 3) = "ファイルサイズ" With CreateObject("Scripting.FileSystemObject") Fo…

Sub 非表示() Dim i As Long For i = 2 To 50 If Cells(i, 3) = "非稼働" Then Rows(i).Hidden = True End If Next i End Sub Sub 表示() Dim i As Long For i = 2 To 50 If Cells(i, 3) = "非稼働" Then Rows(i).Hidden = False End If Next i End Sub

Sub 完全一致転記() 'カウントアップ変数 Dim i As Long '最終行取得用 Dim 最終行 As Long '最終行はA列 最終行 = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To 最終行 If Cells(i, 3) = "" Then Cells(i, 3) = Cells(i, 7) End If Next i End Sub

Sub 対象月の記載() '画面停止Application.ScreenUpdating = False Dim i As Long Dim 先月 As String '先月の１日を取得 先月 = DateSerial(Year(Date), Month(Date) - 1, 1) 'すべてのシートに実行 For i = 1 To Sheets.Count With Worksheets("マスタシー…

Sub シートへの振分け() '画面停止Application.ScreenUpdating = False Dim i As Long 'すべてのシートに実行 For i = 1 To Sheets.Count With Worksheets("マスタシート").Range("A2").CurrentRegion '1列目をシート名でフィルターをかける .AutoFilter Fie…

Sub メモ帳に作成()Dim i As Long 'ファイルを追記モードで開くOpen "C:\Desktop\新しいフォルダー (2).txt" For Append As #1 Print #1, "テストテスト"Print #1, "テストテスト"Print #1, "テストテスト"Print #1, "テストテスト"Print #1, "" '開いたファ…

Sub 列と列の重複判定() Dim i As Long 'チェック記載用のループ変数 For i = 2 To 7 'シート3のA列と、シート1のC列を照合して1以上を抽出 If WorksheetFunction.CountIf(Sheet3.Range("A:A"), Sheet1.Cells(i, 3)) >= 1 Then 'シート1のD列に抽出結果を記…

Sub 〇〇カウント() ' 変数の宣言 Dim 日付 As Long Dim 集計 As Long Dim 集計2 As Long 集計 = WorksheetFunction.CountIfs(Range("A:A"), Date, Range("B:B"), "熊") 集計2 = WorksheetFunction.CountIfs(Range("A:A"), Date, Range("B:B"), "犬") For 日…

Sub 丸丸集計() '変数宣言 Dim カウント As Long Dim 日付 As Long 'オートフィルタの始点 With Range("A1") '日付はA列が今日の日付 .AutoFilter 1, xlFilterToday, xlFilterDynamic 'カテゴリはB列が犬 .AutoFilter 2, "犬" '可視化されているセルが1個以…

Sub 集計() '日付と種類の変数宣言 Dim 日付 As Long Dim 種類 As Long 'ワークシート宣言 Dim 管理シート As Worksheet Dim 集計シート As Worksheet 'ワークシート名設定 Set 管理シート = Sheet1 Set 集計シート = Sheet2 '集計シートの日付を先頭から最…

Range("F4").CopyRange("H5").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Sub セルをシート3にコピー() Dim シート1 As Worksheet Dim シート3 As Worksheet Dim 最終行 As Long Dim 現在日付 As String Dim i As Long ' シート1とシート3のワークシートを取得 Set シート1 = ThisWorkbook.Sheets("Sheet1") Set シート3 = ThisWork…

Sub TextOutput() Dim i As Long 'ファイルを書き込みで開く(無ければ新規作成される、あれば上書き) Open "C:\Desktop\test.txt" For Output As #1 '開いたファイルに書き込むPrint #1, Range("B3").ValuePrint #1, Range("B6").ValuePrint #1, Range("B9")…

Sub メモ帳に出力() Dim 出力文字列 As String Dim ファイル名 As String Dim ファイル番号 As Integer Dim i As Integer Dim シート As Worksheet ' 対象のセルの値を取得 Set シート = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更 出力文字列 = "…

Sub CopyTo37() Dim ws As Worksheet Dim rng28to35 As Range Dim rng37 As Range Dim セル As Range Dim カウント As Integer ' 対象のワークシートを指定 Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更 ' L列の28行目から35行目の範囲を取…

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim 取得番地 As Long 取得番地 = ActiveCell.Row 'ファイルを書き込みで開く(無ければ新規作成される、あれば上書き)Open "C:test.txt" For Output As #1 '開いたファ…

Sub 文字列を変更() Dim 行番号 As Long For 行番号 = 2 To Cells(Rows.Count, 2).End(xlUp).Row Cells(行番号, 2).Value = DateValue(Cells(行番号, 2).Value) Next 行番号 End Sub

Sub sample() '取得したい表を持つURL Const TARGET_URL As String = "https://mulka2.com/lapcenter/lapcombat2/result-list.jsp?event=7218&file=1&class=0" With Worksheets("Sheet1").QueryTables.Add(Connection:="URL;" + TARGET_URL, _ Destination:=…

TEXTSPLIT関数が入ったみたいでもまだ英語みたいこれはVBAでも使えるんだろうか？CSVの扱いに苦労するから、これで開けばゼロ落ちとかしないんだろうか

Sub 列の入れ替え2() Dim 列格納(1) As Variant 列格納(0) = Range("A2:A6") 列格納(1) = Range("B2:B6") Range("B2:B6") = 列格納(0) Range("A2:A6") = 列格納(1) End Sub

Sub 条件一致転記() Dim 転記先シート As Worksheet Dim 参照シート As Worksheet Dim 転記先行番号 As Long Dim 参照行番号 As Long Set 転記先シート = Worksheets("Sheet1") Set 参照シート = Worksheets("Sheet2") For 転記先行番号 = 2 To 転記先シート…

Sub 条件を満たす行を削除() 'E列が男の行を削除する '変数宣言 Dim 最終行 As Long '変数宣言 Dim 行番号 As Long 'A列の最終行まで 最終行 = Cells(Rows.Count, 1).End(xlUp).Row '画面を止める Application.ScreenUpdating = False '最終行から2行目まで…