ばくがの業務効率化チャンネル

このブログは個人的なエクセルの備忘録です

2022-01-01から1年間の記事一覧

コピーと行と列の削除

Sub テスト() 'シート名の変数宣言 Dim シート名 As Worksheet Set ws = Worksheets("Sheet1") 'B列をC列にコピーする Range("C2:C11").Value = Range("B2:B11").Value 'D列をE列にコピーする Range("E2:E11").Value = Range("D2:D11").Value '11行目から14…

文字列を変更

VBA

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

テーブルでVLOOKUP

Sub ルックアップ() Range("テーブル1").Select Range("Q2") = WorksheetFunction.VLookup(Range("P2"), Range("テーブル1"), 5, 0) End Sub

表があるURLからエクセルにDL

VBA

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:=…

新しい関数が入ったみたい

VBA

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

セル内の文字検索

Sub 文字列検索() '縦の列の変数 Dim 縦の列 As Long '横の列の変数 Dim 横の列 As Long '行はA列の2行目から最終行まで For 縦の列 = 2 To Cells(Rows.Count, 1).End(xlUp).Row '列はA列から最終列まで For 横の列 = 1 To Cells(1, Columns.Count).End(xlTo…

=IF( COUNTIF(Sheet1!$A:$A,A5)>=1, "○", IF( COUNTIF(Sheet2!$A:$A,A5)>=1,"〇","×"))

Sub 列の入れ替え2()

VBA

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 列の入れ替え()

Sub 列の入れ替え() Dim シート名 As Worksheet Set シート名 = Worksheets("Sheet1 (3)") 'B列の値を変数に入れる Dim B列 As Variant B列 = シート名.Range("B2:B6") 'C列の値を変数に入れる Dim C列 As Variant C列 = シート名.Range("C2:C6") シート名.R…

条件が一致したら別シートへコピー

VBA

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

E列が男の行を削除する

VBA

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

時間で営業日を振り分ける関数

=IF(C2="","",IF(C2>=TIMEVALUE("17:00"),WORKDAY.INTL(B2,6,1,E3:E5),WORKDAY.INTL(B2,5,1,E3:E5)))

【VBA】 IFで判定してセルに色をつける

VBA

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

不要シートの削除

VBA

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

全シートを式から値に変換

Sub 全シートを式から値に変換() '全てのシートの処理 for i = 1 to sheets.count 'データがある全てのセル範囲を値に変換 sheets(i).usedrange.value = sheets(i).usedrange.value End Sub

【VBA】列の重複判定

VBA

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…

シート名からメールアドレス検索

VBA

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…

各シート調整

VBA

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

各シートに振り分ける

VBA

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()

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 \は円マーク

【VBA】ランダムな日付データ作成

VBA

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】 指定文字列をランダム入力

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…

VBAで縦を横にコピー

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

VBA

自動で足し算の問題ができる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

VBA 最終行の下に転記

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

VBAで日時と曜日を取得してセルに書き込む

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