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

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

メモ帳に出力

VBA

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

別シートから列ごとコピー

Sub データをコピー() Dim シート1 As Worksheet, シート2 As Worksheet Dim 対象値 As Variant Dim 範囲 As Range, セル As Range Dim コピー範囲 As Range ' シートを指定 Set シート1 = ThisWorkbook.Sheets("Sheet1") Set シート2 = ThisWorkbook.Sheets…

一致した場合の転記

VBA

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行目の範囲を取…

シート2から文字列が一致した場合にはコピー

Sub 列ごとコピー() Dim ws1 As Worksheet 'ワークシートの変数宣言1 Dim ws2 As Worksheet 'ワークシートの変数宣言2 Dim val As String Dim col As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") val = ws1.Range("G10").Value '値を取得 c…

プルダウンメニューのカレンダー

=DATE(A1,A2,SEQUENCE(DAY(EOMONTH(DATE(A1,A2,1),0)))) =OFFSET($A$3,0,0,COUNTA($A:$A)-2,1) ※ A1に年 A2に月 セルの書式 yyyy/m/d(aaa)

ダブルクリック

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Column = 1 ThenTarget.Value = DateCancel = TrueElseIf Target.Column = 2 ThenTarget.Value = TimeCancel = TrueEnd IfEnd Sub

Sub メール作成()

Sub メール作成() Dim ファイル名 As StringDim 保存場所 As String 保存場所 = ThisWorkbook.Pathファイル名 = Sheets("Sheet6").Range("B1").Value Open 保存場所 & "\メール作成_" & ファイル名 & ".txt" For Output As #1 Print #1, Range("B2")Print #1…

スピルな関数

FILTER関数で期間を絞る場合 =FILTER(A2:Q46,(Q2:Q46>=T1)*(Q2:Q46<=U1)*(G2:G46=T20),"データなし") '全体参照 '日付参照 '条件参照 =FILTER(Sheet1!dummy,(Sheet1!dummy[有効期限]>=A1)*(Sheet1!dummy[有効期限]<=B1)*(Sheet1!dummy[血液型]=C1),"データ…

クリップボード

www.sejuku.net

Public Function GetCB() As String

'クリップボードの文字列を取得して返す 'MSForms.DataObjectを使用 With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard GetCB = .GetText End With End Function

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

VBA

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 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列…