Sub 同じフォルダ内のファイルを開く() '同じフォルダ内のファイルを開いてコピーする 'パスとファイル名の変数宣言 Dim 保存場所 As String, ファイル名 As String '転記先と転記元の変数宣言 Dim 転記先, 転記元 As Workbook Set 転記先 = ActiveWorkbook …

Sub 最終行が非稼働日() '4列目の最後の稼働日の場合 If Cells(Rows.Count, 4).End(xlUp) = "非稼働日" Then '非稼働日セルの１段上の右は、 Cells(Rows.Count, 4).End(xlUp).Offset(-1, 1) = Cells(Rows.Count, 4).End(xlUp).Offset(-1, 1) + Cells(Rows.Co…

Sub 加算対象セル() '行の変数宣言 Dim 行 As Long '行を31行目からループ処理 For 行 = 31 To 2 Step -1 '4列目の最後の稼働日 If Cells(行, 4) = "稼働日" Then '6列目の合計には、対象の6列目＋E34の合計 Cells(行, 6) = Cells(行, 6) + Range("E35") '対…

Sub 最終行の右下を取得() '最終行が0以上の場合には、一旦枠外に転記する '目的のセルの変数宣言 Dim 目的のセル As Range '取得するセルは日付セルの最終行の1段下の右4列目 Set 目的のセル = Cells(Rows.Count, 2).End(xlUp).Offset(1, 4) '0以上の数字の…

VBAでCOUNTIFSをやってみる どうだろう？関数でも、やっぱりVBAのほうが便利なんだろうか？ 関数の場合には、一旦、セルに組み込みしてしまえばそれほど、その後は工数が かからないと思うのですが

C列に文字が入力されていて、A列が空白の場合には A列に本日の日付を入力する Sub 日付加算() Dim 初回連絡日 As DateDim 経過日 As DateDim 行 As Long For 行 = 2 To 11 初回連絡日 = Cells(行, 2) 経過日 = DateAdd("d", 14, 初回連絡日) If Cells(行, 3)…

Sub 別のシートからVLookup2() '参照範囲の宣言 Dim 参照範囲 As Range '参照範囲はシート3のテーブル Set 参照範囲 = Sheets("Sheet3").Range("A1").ListObject.Range '検索値宣言 Dim 検索値 As Variant '行番号宣言 Dim 行番 As Variant For 行番 = 2 To …

VBAでも検索値を元にデータを引っ張ってくるのはVlookupが早いし便利ですねテーブルの指定は、ListObjectではなくても動作するみたいなんですが、なんか不具合が発生するんですかね

Sub カウント() ' 変数の宣言 Dim 集計 As Integer ' 商品名が「インテリア雑貨」であるセルをカウント 集計 = WorksheetFunction.CountIf(Range("H2:H10"), "インテリア雑貨") ' 集計結果をセルのR2に表示 Range("R2").Value = 集計 End Sub

今回のお題は、空白の列を削除して左につめる

今回のお題は、空白の行を削除して上に詰めるコード youtu.be

Sub 条件判定() Dim i As Long For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 4) = "" Then Cells(i, 5) = "キャンセル" ElseIf Cells(i, 4) = "完了" Then Cells(i, 5) = "完了" Else End If Next i End Sub

Sub 別のシートからVLookup() Dim tbl As Range Set tbl = Sheets("Sheet2").Range("A1:B11") Dim x As String Dim i As Integer For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row x = Range("A" & i + 1).Value On Error Resume Next Dim ret As String re…

Sub オートフィルタのコピー() ’A1の６列目でキーワード絞り込み Range("A1").AutoFilter 6, "キーワード" ’A1のこの範囲を転記先シートのA1を起点にコピー Range("A1").CurrentRegion.Copy Sheets("転記先シート").Range("A1") End Sub

Sub シートへ振分け() Dim i As Long Range("A:A").Copy Range("Q1") Range("Q1").CurrentRegion.RemoveDuplicates 1, xlYes 'A列の重複なしリストをQ列に作成 With Sheets("Sheet1") 'シート1を選択 For i = 2 To Cells(Rows.Count, 17).End(xlUp).Row '2行…

Sub 各シートへの同じ処理() Dim シート名 As Integer '変数としてシート名を使うFor シート名 = 1 To 5 'シート2から4のシートまでSheets(シート名).Select '〇番目のシートを選択する Dim 開始行 As Long '開始行変数宣言Dim 終了行 As Long '終了行変数宣…

Sub 最終行までを一括削除() '開始行から最終行までを一括削除 Dim 開始行 As Long '開始行変数宣言 Dim 終了行 As Long '終了行変数宣言 開始行 = Range("P1").Value '開始行はP1セルの値 終了行 = Cells(Rows.Count, 1).End(xlUp) 'A列の最終行まで Rows(…

Sub 各シートの不要行削除() Dim i As Long '変数宣言 Application.ScreenUpdating = False '画面止める処理 For i = Sheets("Sheet1").UsedRange.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1 '削除対象シートの下から削除 If Sheets("Sheet1").Used…

Sub CSVで保存() '変数宣言 Dim 保存先 As String '保存先設定 保存先 = ThisWorkbook.Path & "\ナレッジ用CSV.csv" 'シートコピー Sheets("Sheet2").Copy 'CSV出力 ActiveWorkbook.SaveAs 保存先, FileFormat:=xlCSV ActiveWorkbook.Close End Sub

Sub 最終行色付け() Dim i As Integer '変数としてiを使う For i = 1 To 3 'シート1からのシートまで Sheets(i).Select 'i番目のシートを選択する Range("A" & Rows.Count).End(xlUp).EntireRow.Font.ColorIndex = 3'最終行色付け Next i'次のシートに移る E…

Sub 各シートへのデータの反映() Dim シート名 As Integer '変数としてシート名を使う For シート名 = 2 To 4 'シート2から4のシートまで Sheets(シート名).Select '〇番目のシートを選択する '各シートの処理 Dim i As Long Application.ScreenUpdating = F…