Sub 各シート調整() 'シート番号変数宣言 Dim シート番号 As Long '3枚目のシートから最終シートまで同じ処理 For シート番号 = 4 To Worksheets.Count 'メールアドレス転記 Worksheets(シート番号).Range("A3") = Worksheets(シート番号).Range("D6") 'メー…

Sub シートへ振分け() '変数宣言 Dim i As Long 'A列をG列にコピーする Range("A:A").Copy Range("G1") 'A列の重複なしリストをG列に作成 Range("G1").CurrentRegion.RemoveDuplicates 1, xlYes 'リストシートを選択 With Sheets("リストシート") '7列目(G列…

Sub sheets_save() Dim シート As Worksheet For Each シート In Worksheets If シート.Name <> "Sheet6" Then シート.Copy ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & シート.Name ActiveWorkbook.Close End If Next シート End Sub \は円マーク

Sub ランダムな日付データ作成() Dim fstDate As Date Dim lstDate As Date Dim 行番号 As Long fstDate = #4/1/2011# 'ランダムに作成する最初の日 lstDate = #9/30/2011# 'ランダムに作成する最後の日 Randomize For 行番号 = 1 To 1000 Cells(行番号, 2) …

Sub 指定文字列をランダム入力() Dim arr(1 To 6) As String Dim 行番号 As Long arr(1) = "スターバックスラテ" arr(2) = "カフェモカ" arr(3) = "ホワイトモカ" arr(4) = "ソイラテ" arr(5) = "カプチーノ" arr(6) = "キャラメルマキアート" Randomize For…

Sub 横縦転記() Range("B2:H2").Copy Range("A5").PasteSpecial Transpose:=True Range("B3:H3").Copy Range("B5").PasteSpecial Transpose:=True Application.CutCopyMode = TrueEnd Sub

Sub 変更日記入() 'B3セルに日付を記入 Range("A4") = Date 'A3セルに時間を記入 Range("B4") = Format(Time, "hh時mm分") End Sub ※日付と時刻から営業日を算出 =IF(OR(A4="",B4=""),"",IF(B4>VALUE("16:00"),WORKDAY.INTL(A4,7,1,E4:E8),WORKDAY.INTL(A4,6…

自動で足し算の問題ができるVBAを作成してみた 実行すると、B列とD列にランダムな数字が入力されます テスト結果を実行するとF列に回答が記載されます

Sub 色塗()Dim 行番号 As Long For 行番号 = 2 To 30 If Cells(2, 行番号) = "土" Then Range(Cells(2, 行番号), Cells(30, 行番号)).Interior.Color = RGB(211, 211, 211) End If Next 行番号 End Sub

Option ExplicitSub 最終行の下に転記() '同じフォルダ内のファイルを開いてコピーする 'パスとファイル名の変数宣言 Dim 保存場所 As String, ファイル名 As String '転記先と転記元の変数宣言 Dim 転記先, 転記元 As Workbook Dim 転記先の最終行, 転記元…

Sub 日時の取得() '変数宣言Dim 本日 As DateDim 期限日 As DateDim 行番号 As Long '本日の日付を取得 本日 = Date '期限日は本日から14日後 期限日 = 本日 + 14 '対象は1列目の最終行まで For 行番号 = 2 To Cells(Rows.Count, 1).End(xlUp).Row '期限日 C…

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…