VBA プログラミング WorksheetFunctionの使い方

目安時間:約 5分

VBA関数以外に、Excelワークシート関数をマクロVBAで使うことが出来ます、
ワークシート関数は、VBA関数よりはるかに多くの関数があるので、ぜひ活用してください。
ワークシート関数を使う事で、VBAコードを非常に簡潔に記述することが出来る場合が多いです。
しかも、劇的な速度向上になりますので、使わない手はない。
【課題】
シート「商品マスタ」より、商品名と単価を取得する。
シート「商品売上」のC列とD列に商品名と単価入れる。
シート「商品マスタ」に存在しない場合は、空欄のままにする。
シート「商品売上」の単価×数量を計算し金額(F列)に入れる。
シート「商品売上」のF12セルに合計金額を計算し入れる。

【VBA】

Sub wsf()
  Dim i As Long
  Dim ix As Long
  Dim lngTotal As Long
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Set ws1 = Worksheets("商品売上")
  Set ws2 = Worksheets("商品マスタ")
  lngTotal = 0
  With ws1
    For i = 2 To 11
      ix = WorksheetFunction.CountIf(ws2.Columns(1), .Cells(i, 2))
      If ix > 0 Then
        ix = WorksheetFunction.Match(.Cells(i, 2), ws2.Columns(1), 0)
        .Cells(i, 3) = ws2.Cells(ix, 2)
        .Cells(i, 4) = ws2.Cells(ix, 3)
        .Cells(i, 6) = .Cells(i, 4) * .Cells(i, 5)
        lngTotal = lngTotal + .Cells(i, 6)
      End If
    Next
    .Cells(12, 6) = lngTotal
  End With
End Sub


簡単な説明
「With ws1」については、前回の記事を参照してください。
「WorksheetFunction.CountIf(ws2.Columns(1), .Cells(i, 2))」は、商品番号検索処理。
・シート「商品マスタ」と、シート「商品売上」の同じ商品番号の数を取得する。
「If ix > 0 Then」は、商品番号の数の比較をする。
・同じ商品番号があればIf文内の処理を行う。
「WorksheetFunction.Match(.Cells(i, 2), ws2.Columns(1), 0)」
・シート「商品マスタ」と、シート「商品売上」の完全一致の商品番号を検索を行う。
・最後の「0」が完全一致を表す。
・その他「-1」は、「検査値」以上の最小値。「1」は、「検査値」以下の最大値。
「.Cells(i, 3) = ws2.Cells(ix, 2)」は、シート「商品売上」に商品名を設定する。
「.Cells(i, 4) = ws2.Cells(ix, 3)」は、シート「商品売上」に単価を設定する。
「.Cells(i, 6) = .Cells(i, 4) * .Cells(i, 5)」は、シート「商品売上」の単価✗数量を設定する。
「lngTotal = lngTotal + .Cells(i, 6)」は、シート「商品売上」の合計に設定する値を算出。
「.Cells(12, 6) = lngTotal」は、シート「商品売上」の合計に設定する。

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBA プログラミング Withで同じオブジェクト名を省略

目安時間:約 4分

今回は、「酒店舗別」「分類別」で集計を行います。
Withの使い方を理解して頂きたいです。
【課題】
シート「Sheet1」、「Sheet1_回答」を用意します。
シート「Sheet1」には、「酒店舗」「分類」「売上」を記載します。
シート「Sheet1_回答」には、シート「Sheet1」の酒店舗・分類別に売上を集計する。
※前提条件 シート「Sheet_回答」には、すべての酒店舗と分類が必ずあるとします。

【VBA】

Sub syukei_Clic()
    Dim i As Long
    Dim ixR As Long
    Dim ixC As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet1_回答")
    ws2.Range("A1").CurrentRegion.Offset(1, 1).ClearContents
    With ws1
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            ixC = 2
            Do Until ws2.Cells(1, ixC) = .Cells(i, 1)
                ixC = ixC + 1
            Loop
            ixR = 2
            Do Until ws2.Cells(ixR, 1) = .Cells(i, 2)
                ixR = ixR + 1
            Loop
            ws2.Cells(ixR, ixC) = ws2.Cells(ixR, ixC) + .Cells(i, 3)
        Next
    End With
End Sub


簡単な説明
ws2.Range("A1").CurrentRegion.Offset(1, 1).ClearContents
・初期クリアーします
「With ws1」〜「End With」は「Sheet1」について処理を行う。
・「.Cells」、「.Rows.Count」については、「ws1.Cells」、「ws1.Rows.Count」を意味します。
・これが、「同じオブジェクト名を省略」ということになります。
「Do Until ws2.Cells(1, ixC) = .Cells(i, 1)」はループ処理を行う。
・「Sheet1」の酒店舗から「Sheet1_回答」と同じ酒店舗を探す。
「Do Until ws2.Cells(ixR, 1) = .Cells(i, 2)」はループ処理を行う。
・「Sheet1」の酒名から「Sheet1_回答」と同じ酒名を探す。
「ws2.Cells(ixR, ixC) = ws2.Cells(ixR, ixC) + .Cells(i, 3)」は、売上合計を算出する。
・「Sheet1」の各酒店舗、各酒名の売上を、「Sheet1_回答」に設定する。

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBAで「行の挿入・削除」やってみる

目安時間:約 3分

今回は、行の挿入、削除を行います。
【課題】
区分がD、No.が空欄の行を削除する。
区分がIの行の前に新規行を挿入する。
No.を上から昇順で振り直す

【VBA】

Sub InsDel()
    Dim i As Long
    Dim lp As Long
    lp = Cells(Rows.Count, 1).End(xlUp).Row - 1
    For i = lp To 2 Step -1
        Select Case Cells(i, 2)
            Case ""
                Rows(i).Delete
        End Select
        Select Case Cells(i, 1)
            Case "I"
                Rows(i).Insert
            Case "D"
                Rows(i).Delete
        End Select
    Next
    lp = Cells(Rows.Count, 1).End(xlUp).Row - 1
    For i = 2 To lp
        Cells(i, 2) = i - 1
    Next
End Sub


簡単な説明
・「Cells(Rows.Count, 1).End(xlUp).Row」は、以前説明をしたのでこちらを御覧ください
A列の最後の「E」行までの行数を取得
・「Rows(i).Delete」は、行を削除する
A列の「D」が記入されているところと、B列の空欄の行を削除する
・「Rows(i).Insert」は、行を追加する
A列の「I」が記入されているところの前に1行追加する
・「Cells(i, 2) = i - 1」のForは、前処理の行の追加削除後にNo.を振り直すループを行う
・Selectについては、前回に説明したこの記事を御覧ください。

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBAで「文字列の切り出しと文字列の結合」やってみる

目安時間:約 5分

今回は、文字列の切り出し、文字列の結合を行います。
「最高に色っぽい女優ランキング」から名前を使わせて頂きました。
【課題】
漢字の苗字、ふりがなの苗字、漢字の名前、ふりがなの名前を使い
漢字の苗字名前をC列に設定、ふりがなの苗字名前をD列に設定する
例:深田(ふかだ)恭子(きょうこ)の場合
 C列:深田恭子
 D列:ふかだきょうこ

【VBA】

Sub cutUnion()
    Dim i As Long
    '苗字変数
    Dim miyo1 As String
    Dim miyo2 As String
    Dim miyobuf1 As String
    Dim miyobuf2 As String
    Dim miyobuf3 As String
    '名前変数
    Dim name1 As String
    Dim name2 As String
    Dim namebuf1 As String
    Dim namebuf2 As String
    Dim namebuf3 As String
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        miyobuf1 = InStr(Cells(i, 1), "(")
        miyobuf2 = InStr(Cells(i, 1), ")") - 1
        miyobuf3 = miyobuf2 - miyobuf1
        miyo1 = Left(Cells(i, 1), miyobuf1 - 1)
        miyo2 = Mid(Cells(i, 1), miyobuf1 + 1, miyobuf3)

        namebuf1 = InStr(Cells(i, 2), "(")
        namebuf2 = InStr(Cells(i, 2), ")") - 1
        namebuf3 = namebuf2 - namebuf1
        name1 = Left(Cells(i, 2), namebuf1 - 1)
        name2 = Mid(Cells(i, 2), namebuf1 + 1, namebuf3)
       ' 苗字名前
       Cells(i, 3) = miyo1 & name1
       ' 苗字名前(ふりがな)
       Cells(i, 4) = miyo2 & name2
    Next
End Sub


簡単な説明
・「Cells(Rows.Count, 1).End(xlUp).Row」は、以前説明をしたのでこちらを御覧ください
・「miyobuf1 = InStr(Cells(i, 1), "(")」は、「"("」の位置を取得する
 「深田(ふかだ)」の場合、3を取得する
・「miyobuf2 = InStr(Cells(i, 1), ")") - 1」は、「")"」の位置を取得し、-1をする
 「深田(ふかだ)」の場合、6を取得する
・「miyobuf3 = miyobuf2 - miyobuf1」は、「深田(ふかだ)」の「ふかだ」を取得する文字数を取得する
・「miyo1 = Left(Cells(i, 1), miyobuf1 - 1)」は、「深田(ふかだ)」の左から「miyobuf1 - 1:3−1=2」2文字取得する
・「miyo2 = Mid(Cells(i, 1), miyobuf1 + 1, miyobuf3)」は、「深田(ふかだ)」の左の「miyobuf1 + 1:4」文字目から「miyobuf3:3」文字いを取得する。
 「深田(ふかだ)」の場合、「ふかだ」を取得する。

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBAで「日付と曜日」使って集計表示する

目安時間:約 5分

今回は、日付から曜日を求めて「売上合計」「日数」「平均売上」を集計する
【課題】
売上合計が多い順に背景色を設定
売上合計1位背景色 → 赤
売上合計2位背景色 → 緑
売上合計3位背景色 → 水色
G2〜I8に「売上合計」「日数」「平均売上」を設定する

【VBA】

Sub weekdate()
    Dim i As Long
    Dim lp As Long
    Dim intW As Integer
    Range("G2:I8").ClearContents
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        intW = Weekday(DateSerial(Cells(i, 1), Cells(i, 2), Cells(i, 3)), vbMonday)
        Cells(intW + 1, 7) = Cells(intW + 1, 7) + Cells(i, 4)
        Cells(intW + 1, 8) = Cells(intW + 1, 8) + 1
    Next
    For i = 1 To 7
        Cells(i + 1, 9) = Cells(i + 1, 7) / Cells(i + 1, 8)
    Next
    Set rng_jp = Range("G2:G8")
    lp = 2
    For Each Rng In rng_jp
        rk = WorksheetFunction.Rank(Rng.Value, rng_jp)
        Select Case rk
            Case 1
                Cells(lp, 7).Interior.Color = vbRed
            Case 2
                Cells(lp, 7).Interior.Color = vbGreen
            Case 3
                Cells(lp, 7).Interior.Color = vbCyan
        End Select
        lp = lp + 1
    Next
End Sub


簡単な説明
・「Range("G2:I8").ClearContents」では、セル範囲の値をクリアをする
・「Cells(Rows.Count, 1).End(xlUp).Row」は以前説明をしたのでこちらを御覧ください
・「DateSerial(year,month,day)」は、3つの引数で指定された日付を意味するシリアル値を返す
ー 引数yearは、年を表す0〜9999の範囲の数値または数式を指定します。
ー 引数monthは、月を表す1〜12の範囲の数値または数式を指定します。
ー 引数dayは、日を表す1〜31の範囲の数値または数式を指定します。
ー ※ 引数yearに0〜29を指定すると、2000年〜2029年と読み替えられます。
ー また、30〜99を指定すると、1939年〜1999年と読み替えられます。
・「Weekday(シリアル値,種類)」は、シリアル値から曜日に対応する数値を求める。
・「vbMonday」は、「DateSerial(Cells(i, 1), Cells(i, 2), Cells(i, 3))」で指定した日付が何曜日かを返す。
・「Cells(i + 1, 9) = Cells(i + 1, 7) / Cells(i + 1, 8)」は平均売上を算出する。
・「Set rng_jp = Range("G2:G8")」は、Setを使ってRange型変数に代入する。
・「WorksheetFunction.Rank(Rng.Value, rng_jp)」は、指定された範囲の中で数値の高い順位を返します。
・「Select Case rk」は、1〜3位の背景色を設定する。

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBAで「セルのコピー」を表示する

目安時間:約 2分

今回は、前回の「文字、背景色も含めセルのコピー」ではなく
「文字、背景色」以外のセルのコピーをしてみました。
このセルのコピー方法については、下記の2つの方法をお伝えします
【課題】
・A1セル~B6セルをコピーする
・D1セル~E6セルにペーストする

【VBA】

※方法1

Sub セルコピー()
    Range("A1:B6").Copy
    Range("D1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

※方法2

Sub セルコピー()
    Range("D1:E6").Value = Range("A1:B6").Value
End Sub


簡単な説明
【方法1】
「Range("A1:B6").Copy」は、A1〜B6をコピーする
「xlPasteValues」は、値のみ貼り付けする
「Application.CutCopyMode = False」は、貼り付けが終わってコピーモードを解除する
【方法2】
「Range("D1:E6").Value = Range("A1:B6").Value」は、A1〜B6の範囲をD1〜E6に貼り付ける

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBAで「文字、背景色も含めセルのコピー」を表示する

目安時間:約 2分

今回は、セルのコピーをしてみました。
文字の色、背景色もコピーします。
このセルのコピー方法については、下記の2つの方法をお伝えします
【課題】
・A1セル~B6セルをコピーする
・D1セル~E6セルにペーストする

【VBA】

※方法1

Sub セルコピー()
    Range("A1:B6").Copy Range("D1")
End Sub

※方法2

Sub セルコピー()
    Range("A1:B6").Copy Destination:=Range("D1")
End Sub


簡単な説明
【方法1】
「Range("A1:B6").Copy Range("D1")」は、A1〜B6をコピーしてD1〜E6にペーストする
【方法2】
「Destination」は、貼り付け先のセル範囲を表す

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBAで「罫線」を表示する

目安時間:約 4分

今回は、比率の計算と、計算結果にて、文字の色、背景色を付けるようにしました。
【課題】
・客単価を計算してD列に入れる。
・客単価は「売上 ÷ 客数」で計算し、小数以下2桁で表示する。
・罫線を表示する。

【VBA】

Sub 罫線()
    Dim i As Long
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).row
    For i = 2 To lastRow
        Cells(i, 4) = Cells(i, 2) / Cells(i, 3)
    Next
    Range(Cells(2, 4), Cells(lastRow, 4)).NumberFormatLocal = "#,##0.00"
    Range(Cells(1, 1), Cells(lastRow, 4)).Borders.LineStyle = xlContinuous
    Range(Cells(1, 1), Cells(lastRow, 4)).Borders.Weight = xlHairline
    Range(Cells(1, 1), Cells(lastRow, 4)).BorderAround Weight:=xlMedium
    Range(Cells(2, 1), Cells(2, 4)).Borders(xlEdgeTop).Weight = xlThin
    Range(Cells(1, 2), Cells(lastRow, 2)).Borders(xlEdgeLeft).Weight = xlThin
End Sub


簡単な説明
・「Cells(Rows.Count, 1).End(xlUp).row」は以前説明をしたのでこちらを御覧ください
・「For」は、客単価の計算をして設定
・「NumberFormatLocal = "#,##0.00"」は、小数以下2桁表示にする
・罫線の種類は「Borders.LineStyle」にて設定
・「xlContinuous」は、罫線の直線を表す
・罫線の太さは「Borders.Weight」にて設定
・「xlHairline」は、罫線の太さを表し、「極細」を設定
・罫線の外枠は、「BorderAround Weight:」にて設定
・「xlMedium」は、罫線の太さを表し、「中」を設定
・「xlEdgeTop」は、罫線の位置で「上端」
・「xlThin」は、罫線の太さを表し、「細」を設定
・「xlEdgeLeft」は、罫線の位置で「左端」

あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

VBAで「比率計算・文字色・背景色」を表示する

目安時間:約 4分

今回は、比率の計算と、計算結果にて、文字の色、背景色を付けるようにしました。
【課題】
・昨年比欄 背景青、白文字 : 105%以上
・昨年比欄 青文字 : 100%以上、105%未満
・昨年比欄 黒文字 : 95%以上、100%未満
・昨年比欄 赤文字 : 90%以上、95%未満
・昨年比欄 背景赤、黒文字 : 90%未満
・前年売上差欄 今年売上 - 昨年売上

【VBA】

Sub 比率計算()
    Dim i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).row
        Cells(i, 5) = Cells(i, 3) / Cells(i, 2)
        Cells(i, 4) = Cells(i, 3) - Cells(i, 2)
        Select Case Cells(i, 5)
            Case Is >= 1.05
                Cells(i, 5).Interior.Color = vbBlue
                Cells(i, 5).Font.Color = vbWhite
            Case Is >= 1
                Cells(i, 5).Font.Color = vbBlue
            Case Is >= 0.95
                Cells(i, 5).Font.Color = vbBlack
            Case Is >= 0.9
                Cells(i, 5).Font.Color = vbRed
            Case Else
                Cells(i, 5).Interior.Color = vbRed
                Cells(i, 5).Font.Color = vbBlack
        End Select
    Next
End Sub


簡単な説明
・「Cells(Rows.Count, 1).End(xlUp).row」は以前説明をしたのでこちらを御覧ください
・「Select Case Cells(i, 5)」は、IF〜ElseIf〜End文のようなものです。
・「Interior.Color」は、セルに塗りつぶしの色を設定する
・「Font.Color 」は、文字の色を設定する
・「vbBlue」等は、色指定です
ちなみに、「vbBlue」「vbWhite」「vbBlack」「vbRed」は何色?


あなたのお役に立てるなら、コピーして使用してください。

今後も勉強した内容を記載して行きますので、お役に立てるものがあれば使ってください。

VBA開発もしておりますので開発のご要望があればご連絡をください。

VBA開発依頼受付はこちらから

プログラミング依頼

目安時間:約 1分

プロフィール

50歳、派遣社員。いつもいつも派遣切りにビクビクしながら生きています。50歳という大台を迎えると派遣先がほとんどなく、次の派遣先は無いに等しい。でも、家庭を支えなければならない。だから私は、複数の仕事が出来るように在宅ワークが出来るプログラミング、ブログを選択。50歳からフリーランスを目指してプログラミング、ブログを始めました。

私と一緒に始めませんか?

お問い合わせ
プログラミング依頼

 

最近の投稿
アーカイブ

ページの先頭へ