投稿日:

【Excel】Delete時に元の関数をセット

VLOOKUP 関数等を利用している場合、スポット的に直接値を入れたいケースがあると思います。

直接入れた値の削除時にもともと設定してあったVLOOKUP関数を再セットするプログラムを作成します。

Icon

FunctionDisplayOnDeletion.zip

1 file(s) 16.22 KB
エクセルファイルをダウンロード

このエクセルファイルの作り方

①マクロを使えるようにする
「マクロを使えるようにする」を参照

②ＶＬＯＯＫＵＰ関数の参照元、先を作成

③「Alt + F8」を押して表示される以下の画面で「マクロ名」を「FunctionDisplayOnDeletion」として「作成」を押す

④ Microsoft Visual Basic for Applications」にて以下のコードを記載 

Sub FunctionDisplayOnDeletion()
    Dim searchValueRow As Integer: searchValueRow = 1 '★検索値列
    Dim startFuncRow As Integer: startFuncRow = 2 '★VLOOKUP関数設定開始行
    Dim startFuncCol As Integer: startFuncCol = 2 '★VLOOKUP関数設定開始列
    Dim endFuncCol As Integer: endFuncCol = 3 '★VLOOKUP関数設定終了列
    
    Dim c As Range, i As Long
    For Each c In Selection
        If c.Row >= startFuncRow _
           And c.Column >= startFuncCol _
           And c.Column <= endFuncCol Then
            c.Value = "=IFERROR(VLOOKUP(" & Cells(c.Row, searchValueRow).Address(False, False) & ",品目情報!$A$2:$C$5," & c.Column & ",FALSE),"""")"
        Else
            c.Value = ""
        End If
    Next c
    
End Sub
Sub AutoActivateSheet_Name()
    'DeleteKeyを押すと「FunctionDisplayOnDeletion」マクロ実行
    Application.OnKey "{Delete}", "FunctionDisplayOnDeletion"
    Application.OnKey "^{Delete}", "FunctionDisplayOnDeletion"
End Sub
Sub AutoDeactivateSheet_Name()
    'DeleteKeyへの割り当て解除
    Application.OnKey "{Delete}"
    Application.OnKey "^{Delete}"
End Sub
Sub Auto_Open()
    '「見積り入力」シートがアクティブになったら「AutoActivateSheet_Name」マクロ実行
    Worksheets("見積り入力").OnSheetActivate = "AutoActivateSheet_Name"
    '「見積り入力卸」シート以外がアクティブになったら「AutoDeactivateSheet_Name」マクロ実行
    Worksheets("見積り入力").OnSheetDeactivate = "AutoDeactivateSheet_Name"
End Sub
投稿日:

【Excel】セルに名前を付けてハイパーリンクを設定する

名前の定義によってセルに名前を付け、その名前に対してハイパーリンクを設定する方法です。
座標を指定したハイパーリンクとは異なり、対象セルの行や列が変動した場合も影響を受けずにリンクする事が可能です。

【前提】「2018」シートから「基本情報」シートへリンクする

①セルに名前を付ける

②名前を指定したハイパーリンクを設定

投稿日:

【Excel】CSVファイルをリアルタイム読み取り

VBAを利用して、随時更新されるcsvファイルをリアルタイムで読み取るプログラムを作成しました。
随時更新される売上データを題材に作成しています。

Icon

csvReadImmediately.zip

1 file(s) 34.90 KB
エクセルファイルをダウンロード

このエクセルファイルの作り方

①マクロを使えるようにする

「マクロを使えるようにする」を参照

②元データとするCSVファイルを用意

③読み取ったCSVを書き込むテーブルを作成

④テーブルの値を集計する任意のピボットグラフを作成

⑤集計開始をするボタンを用意

※ボタンの追加方法は「以前の記事」を参考

⑥マクロを作成する

ボタン配置時の以下の画面で「マクロ名」を「Addup_Click」として「新規作成」を押す

⑤「Microsoft Visual Basic for Applications」にて以下のコードを記載

必要に応じて「★」のついた箇所を変更

Sub Addup_Click()
    Call ReadCSV
End Sub

Function ReadCSV()
    '★読み込み対象ファイルの絶対パスを指定
    Dim filePass  As String: filePass = "C:\SalesData.csv"
    '★書き込みを開始する行・列を指定
    Dim startRow As Integer: startRow = 2
    Dim startCol As Integer: startCol = 1
    '★定期実行する間隔を指定
    Dim waitSec As Single: waitSec = 5
    
    Dim targetRow As Integer: targetRow = startRow
    Dim targetCol As Integer: targetCol = startCol
    Dim rowBuf  As String
    Dim cellBufList As Variant
    
    Open filePass For Input As #1
    
    '全行読み込み終わるまで繰り返し
    Do Until EOF(1)
        '１行読み込み
        Line Input #1, rowBuf
        '読みこんだ１行をカンマで区切り配列化
        cellBufList = Split(rowBuf, ",")
    
        '配列分繰り返し
        For Each cellBuf In cellBufList
            Cells(targetRow, targetCol).Value = cellBuf
            '次の列へ
            targetCol = targetCol + 1
        Next cellBuf
        
        '次の行へ
        targetCol = startCol
        targetRow = targetRow + 1
    Loop
    Close #1
    
    'ピボットテーブルの更新
    Dim pvt As PivotTable

    For Each pvt In ActiveSheet.PivotTables
        pvt.PivotCache.Refresh
    Next
    
    '待機処理
    Dim Tm As Single
    Tm = Timer
    
    Do
        DoEvents
    Loop Until Timer > Tm + waitSec
    
    '再帰
    Call ReadCSV
    
End Function

投稿日:

【Excel】ビンゴゲームを作る

Icon

bingo.zip

1 file(s) 22.17 KB
エクセルファイルをダウンロード

 

このエクセルファイルの作り方

①ビンゴゲームのレイアウトを作成する

・A1:L16 ⇒ ビンゴの数字表示欄
・M2:Q16 ⇒ ビンゴで出た数字の背景色を緑色で表示
・「BINGO」ボタン ⇒ ルーレットを開始して「A1:L16」に数字を表示
・「Initialize」ボタン ⇒ 初期化
※各ボタン配置時に設定するマクロ名はそれぞれ「Bingo」、「Initialize」とする

②Microsoft Visual Basic for Applications」にて以下のコードを記載

Sub Bingo()
'結果
Dim result As Integer
'(これまでに出た)結果リスト
Dim resultList As Variant: resultList = Range("A21:A95")

'1～75まで全て出ている場合はなにもしない
If (IsEmpty(Range("A95").Value) = False) Then
GoTo PROCESSINGEXIT
End If

'ボタンを配置したセルを選択する
Cells(1, 13).Select

'フォントサイズを設定
Worksheets("BINGO").Range("A2").Font.Size = 350

'ルーレット表示
For i = 1 To 100
Application.Wait [Now()] + 5 / 86400000
result = Int(75 * Rnd + 1)
Worksheets("BINGO").Range("A2").Value = result
Next

'重複制御
Do While (1)
result = Int(75 * Rnd + 1)
For i = 1 To UBound(resultList)
If (resultList(i, 1) = result) Then
GoTo BREAK
End If
Next
Exit Do
BREAK:
Loop
Worksheets("BINGO").Range("A2").Value = result

'結果書き込み
For i = 1 To UBound(resultList)
If (IsEmpty(Cells(i + 20, 1).Value) = True) Then
Cells(i + 20, 1).Value = result
Exit For
Else
GoTo CONTINUE
End If
CONTINUE:
Next

PROCESSINGEXIT:

End Sub

Sub Initialize()
Range("A21:A95").ClearContents<img src="https://exceldemon.net/wp-content/uploads/2018/11/条件付き書式.png" alt="" width="379" height="396" class="alignnone size-full wp-image-432" />
Worksheets("BINGO").Range("A2").Font.Size = 15
Worksheets("BINGO").Range("A2").Value = "Please press ""BINGO"" button"
End Sub

③条件付き書式を設定

※すでに出た数値の背景色を緑色とする

プログラムの解説

'ルーレット表示
For i = 1 To 100
Application.Wait [Now()] + 5 / 86400000
result = Int(75 * Rnd + 1)
Worksheets("BINGO").Range("A2").Value = result
Next

100回ループさせ、「Application.Wait [Now()] + 5 / 86400000」の記載で5ミリ秒ごと1～75のランダムな数値を表示

'重複制御
Do While (1)
result = Int(75 * Rnd + 1)
For i = 1 To UBound(resultList)
If (resultList(i, 1) = result) Then
GoTo BREAK
End If
Next
Exit Do
BREAK:
Loop
Worksheets("BINGO").Range("A2").Value = result

「Do While (1)」で無限ループを発生。
「result = Int(75 * Rnd + 1)」でresultに1～75のランダムな数値を格納する。

「For i = 1 To UBound(resultList)～Next」でresultList分ループし、
resultListにresultの数値がすでに含まれている場合はBREAKして再度1～75のランダムな数値を格納し直す。
含まれていない数値だった場合は「Exit Do」でループを抜けて、「A2」にresultの数値をセット。

'結果書き込み
For i = 1 To UBound(resultList)
If (IsEmpty(Cells(i + 20, 1).Value) = True) Then
Cells(i + 20, 1).Value = result
Exit For
Else
GoTo CONTINUE
End If
CONTINUE:
Next

「For i = 1 To UBound(resultList)～Next」でresultList分ループし、
値が入っていないCellまで来たら今回Resultに格納している数値を書き込む

Sub Initialize()
Range("A21:A95").ClearContents
Worksheets("BINGO").Range("A2").Font.Size = 15
Worksheets("BINGO").Range("A2").Value = "Please press ""BINGO"" button"
End Sub

「Range(“A21:A95”).ClearContents」で背景色が緑色になったところを元に戻す。
初期のフォントサイズと初期値を設定。

投稿日:

【Excel】同率(順位重複)を考慮したランキング表

①アンケート表、集計表を作成

②アンケート表に総数行を用意
「=COUNTA(C3:C20)」と入力してG列までコピー

③アンケート表に順位行を用意
「=RANK.EQ(C21,$C$21:$G$21)」と入力してG列までコピー

④アンケート表に順位(一意)行を用意
「=IF(COUNTIF($A$23:B23,C22)>0,C22 + 1,C22)」と入力してG列までコピー
※重複を回避するため、現在地より左ですでに同じ値がある場合は+1をする

⑤集計表に順位(一意)列を用意

⑥順位(一意)を元に集計表の順位を表示
「=INDEX($C$22:$G$22,MATCH(A27,$C$23:$G$23, 0))」と入力して31行目までコピー

⑦順位(一意)を元に集計表に旅行先を表示
「=INDEX($C$2:$G$2,MATCH(A27,$C$23:$G$23,0))」と入力して31行目までコピー

⑧不要行・列を非表示