Sub テスト() Dim i As Long For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row If Cells(i, 4) <>"" And Cells(i, 2) <> Cells(i, 4) Then Cells(i, 3).Interior.ColorIndex = 3 End If Next i End Sub

Sub 不要シートの削除() '警告停止 Application.DisplayAlerts = False 'ワークシート削除 Worksheets(Array("Sheet1", "Sheet3")).Delete '警告戻し Application.DisplayAlerts = True End Sub

Sub 重複判定() Dim 行番号 As Long Dim 最終行 As Long With ActiveSheet 'A列の最終行を取得 最終行 = .Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行まで繰り返し For 行番号 = 2 To 最終行 'B列の番号の重複確認 If WorksheetFunction.CountIf(.Ra…

Sub シート名からメールアドレス検索() Dim 行番号, シート番号 As Long For シート番号 = 4 To Worksheets.Count For 行番号 = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(行番号, 1) = Sheets(シート番号).Name Then Sheets(シート番号).Range("A1…

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 ランダムな日付データ作成() 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) …

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

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…