Top > エクセル関数をVBAで置き換える

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

エクセル関数をVBAで置き換える

エクセル関数をVBAで置き換える

エクセル関数をVBAで置き換える エクセルには色々な関数があります。
・基本関数
・財務関数
・文字列操作関数とエンジニア関数
・数学/三角関数と統計関数
・日付/時刻関数
・検索/行列関数

仕事によって使う関数が違ってきます。
VBAを使ってエクセルにない関数を作ることができます。
VBAでエクセルの関数を使うことができますが、異なる関数もあります。
ここでは勉強のためにエクセルの関数をVBAで書く練習をしてみましょう。
(1)sumif・sumifs関数
(2)subtotal関数
(3)vlookup関数

(1)sumif・sumifs関数

エクセル関数をVBAで置き換える

科目集計・月別集計は
エクセルでは
=SUMIF($B$3:$B$15,E3,$C$3:$C$15)
=SUMIFS($C$3:$C$15,$A$3:$A$15,">=2013/4/1",$A$3:$A$15,"<=2013/4/30")
VBAの科目集計・月別集計は
Sub keisan()
  Dim i As Long
  Dim kotae1 As Long
  Dim kotae2 As Long
  Dim kotae3 As Long
'科目集計
  For i = 3 To 15
    Select Case Cells(i, 2)
      Case "商品"
        kotae1 = kotae1 + Cells(i, 3)
      Case "交通費"
        kotae2 = kotae2 + Cells(i, 3)
      Case "事務用品"
        kotae3 = kotae3 + Cells(i, 3)
    End Select
  Next
  Cells(3, 6) = kotae1
  Cells(4, 6) = kotae2
  Cells(5, 6) = kotae3
'月別集計
  kotae1 = 0
  kotae2 = 0
  kotae3 = 0
  For i = 3 To 15
    Select Case Cells(i, 1)
      Case "2013/04/01" To "2013/04/30"
        kotae1 = kotae1 + Cells(i, 3)
      Case "2013/05/01" To "2013/05/31"
        kotae2 = kotae2 + Cells(i, 3)
      Case "2013/06/01" To "2013/06/30"
        kotae3 = kotae3 + Cells(i, 3)
    End Select
  Next
  Cells(3, 8) = kotae1
  Cells(4, 8) = kotae2
  Cells(5, 8) = kotae3
End Sub

(2)subtotal関数

(a)エクセルの関数と概要

エクセル関数をVBAで置き換える

エクセルの関数は全件数はcount(A4:A16) すべての合計はsum(A4:A16)
フィルターをつけて抽出した選んだ件数はsubtotal(2,A4:A16)
選んだ合計はsubtotal (9,A4:A16)
2はカウントの引数9は合計の引数
VBAの場合はフォームを使って抽出を行います。
フィルターの方が各項目を自由に選べて楽に見えますがパソコンに慣れていない方にとってみればフォームでチェックボックス等で選ぶ方が使いやすいと思います。

(b)抽出フォーム

エクセル関数をVBAで置き換える

フォームを作る時は各オブジェクトに名前を付けないといけません。
フォーム名をfrmTyusyutuとします。
フォームをボタンとリンクするために標準モジュールに
Sub tyusyutu()
  frmTyusyutu.Show
End Sub
を書きます。
フォームが呼ばれた時に初期値を代入します。
日付・金額とも最小値・最大値を条件文のついた繰り返しで取得します。
次のプログラムを参考にしてフォームを作成してください。
Private Sub UserForm_Initialize()
  Dim i As Long
  Dim sdate As Date
  Dim edate As Date
  Dim skingaku As Long
  Dim ekingaku As Long
'日付
  sdate = Cells(4, 1)
  edate = Cells(4, 1)
  For i = 4 To 16
    If sdate >= Cells(i, 1) Then
      sdate = Cells(i, 1)
    End If
    If edate <= Cells(i, 1) Then
      edate = Cells(i, 1)
    End If
  Next
  txtSdate.Text = sdate
  txtEdate.Text = edate
'費目
  chkKoutuuhi.Value = True
  chkJimu.Value = True
  chkSyouhin.Value = True
'金額
  skingaku = 0
  txtSkin.Text = skingaku
  ekingaku = Cells(4, 3)
  For i = 7 To 21
    If ekingaku <= Cells(i, 3) Then
      ekingaku = Cells(i, 3)
    End If
  Next
  txtEkin.Text = ekingaku
End Sub

(c)データの抽出

エクセル関数をVBAで置き換える

3つの抽出条件(日付・費目・金額)の該当データを一気に取り出すことはできないことはないですが、例えばエクセルの3重IF文を考えてみてください。
1つの条件づつシートに取り出してはまた次の作業シートに取り出す方法であればわかりやすいと思います。
実行ボタンを押したときに抽出を行い最後に結果をもとの抽出箇所にコピーします。
Private Sub cmdJikkou_Click()
  Dim i As Long
  Dim kensu As Long
  Dim kingaku As Long
  Dim j As Long
  Dim lastrow As Long
'クリアにする
'作業シート
  For i = 1 To 13
    Worksheets("作業").Cells(i, 1) = ""
    Worksheets("作業").Cells(i, 2) = ""
    Worksheets("作業").Cells(i, 3) = ""
  Next
'作業1シート
  For i = 1 To 13
    Worksheets("作業1").Cells(i, 1) = ""
    Worksheets("作業1").Cells(i, 2) = ""
    Worksheets("作業1").Cells(i, 3) = ""
  Next
'抽出シートの表示
  For i = 4 To 16
    Worksheets("明細").Cells(i, 5) = ""
    Worksheets("明細").Cells(i, 6) = ""
    Worksheets("明細").Cells(i, 7) = ""
  Next
'全データの件数・金額
  For i = 4 To 16
    kensu = kensu + 1
    kingaku = kingaku + Cells(i, 3)
  Next
  Worksheets("明細").Cells(1, 3) = kensu
  Worksheets("明細").Cells(1, 5) = kingaku
  j = 1
'作業シートに取り出す
'日付の取り出し
  For i = 4 To 16
    If Worksheets("明細").Cells(i, 1) >= txtSdate.Text And Worksheets("明細").Cells(i, 1) <= txtEdate.Text Then
      Worksheets("作業").Cells(j, 1) = Cells(i, 1)
      Worksheets("作業").Cells(j, 2) = Cells(i, 2)
      Worksheets("作業").Cells(j, 3) = Cells(i, 3)
      j = j + 1
    End If
  Next
'費目の取り出し
  lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
  j = 1
  For i = 1 To lastrow
    If chkKoutuuhi.Value = True Then
      If Worksheets("作業").Cells(i, 2) = chkKoutuuhi.Caption Then
        Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
        Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
        Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
        j = j + 1
      End If
    End If
    If chkJimu.Value = True Then
      If Worksheets("作業").Cells(i, 2) = chkJimu.Caption Then
        Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
        Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
        Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
        j = j + 1
      End If
    End If
    If chkSyouhin.Value = True Then
      If Worksheets("作業").Cells(i, 2) = chkSyouhin.Caption Then
        Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
        Worksheets("作業1").Cells(j, 2) = Worksheets("作業").Cells(i, 2)
        Worksheets("作業1").Cells(j, 3) = Worksheets("作業").Cells(i, 3)
        j = j + 1
      End If
    End If
  Next
'作業シートクリアにする
  For i = 1 To 15
    Worksheets("作業").Cells(i, 1) = ""
    Worksheets("作業").Cells(i, 2) = ""
    Worksheets("作業").Cells(i, 3) = ""
  Next
'金額の取り出し
  lastrow = Worksheets("作業1").Cells(Rows.Count, 1).End(xlUp).Row
  j = 1
  For i = 1 To lastrow
    If Worksheets("作業1").Cells(i, 3) >= Val(txtSkin.Text) And Worksheets("作業1").Cells(i, 3) <= Val(txtEkin.Text) Then
      Worksheets("作業").Cells(j, 1) = Worksheets("作業1").Cells(i, 1)
      Worksheets("作業").Cells(j, 2) = Worksheets("作業1").Cells(i, 2)
      Worksheets("作業").Cells(j, 3) = Worksheets("作業1").Cells(i, 3)
      j = j + 1
    End If
  Next
'作業シート抽出データの件数・金額
  lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
  kensu = 0
  kingaku = 0
  For i = 1 To lastrow
    kensu = kensu + 1
    kingaku = kingaku + Worksheets("作業").Cells(i, 3)
  Next
  Worksheets("明細").Cells(2, 3) = kensu
  Worksheets("明細").Cells(2, 5) = kingaku
'抽出データの表示
  j = 4
  For i = 1 To lastrow
    Worksheets("明細").Cells(j, 5) = Worksheets("作業").Cells(i, 1)
    Worksheets("明細").Cells(j, 6) = Worksheets("作業").Cells(i, 2)
    Worksheets("明細").Cells(j, 7) = Worksheets("作業").Cells(i, 3)
    j = j + 1
  Next
  Unload Me
End Sub

(3)vlookup関数

エクセル関数をVBAで置き換える

コード番号を入力すれば得意先シートの得意先名を検索して得意先名をコード番号の隣に表示します。
・vlookup関数の場合
vlookup関数を得意先名に作成します。
= VLOOKUP(A2,得意先!$A$1:$B$14,2)
得意先シートは14行までデータが入力されているとします。
1列目がコード番号2列目が得意先名が入力されています。
得意先名のすべての行にコピーするために絶対座標$A$1:$B$14を使っています。
コード番号が入力さえていないとエラーになりますので条件文をつけておきます。
=IF(A2="","",VLOOKUP(A2,得意先!$A$1:$B$14,2))
・VBAの場合
ではVBAではどのようになるかということです。
今回の場合はvlookup関数を使ったほうが楽です。
VBAの特徴はシートに計算式を記入しませんので計算式を誤って消してしまうということがないぐらいです。
勉強のために作っていきます。
7行A列(cells(1,7))にコード番号8を入力しておきます。
そこでエンターキーを押すと得意先名が表示すようにするためにはキーコード13を判断しますが今回は得意先検索ボタンをクリックしたときに得意先名が表示するようにします。
今入力したセルをActiveCellで取得します。
ボタンの付いている売上シートがアクティブですからシート名を省略できますが
シート名をつけた方がわかりやすいかもわかりません。
Worksheets("売上").Cells(ActiveCell.Row, 2) = Worksheets("得意先").Cells(i, 2)
条件付き繰り返しが理解できておれば問題はないと思います。
Sub kensaku()
  Dim i As Long
  im lastRow As Long
  lastRow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastRow
    If ActiveCell = Worksheets("得意先").Cells(i, 1) Then
      Cells(ActiveCell.Row, 2) = Worksheets("得意先").Cells(i, 2)
      Exit Sub
    End If
  Next
End Sub

先頭へ

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)