レッスン-投稿一覧パソコン仕事５倍塾ポータル

投稿/コメントを表示します。

エクセルVBA外部連携講座

テキストファイルの操作について

たかちゃんさんの投稿

(投稿ID: 4996)

CSVのデータ分析について、マクロを書きました。Excel2019動作確認済み。（記念投稿）

【概要】
毎日、通販の販売状況がCSVで吐き出される。
CSVの中身
A列　親－商品番号
B列　子－商品番号
C列　商品名（商品名は長い。）
D列　セッション（ユーザ訪問数）
E列　セッションのパーセンテージ
F列　ページビュー
G列　ページビュー率
H列　カートボックス獲得率
I列　注文された商品点数
J列　商品購入率
K列　注文商品売上（円）
L列　注文品目総数
CSVのファイル名には日時を含む。

【マクロで実現すること】
１つめのマクロ：
特定のフォルダに複数CSVを格納し、dataシートへデータを転記。
１行名は見出し。（日付、商品名・・・）
２行目以降はデータを転記
A列はファイル名から日付を取得し転記
B列以降は、上記の親ー商品番号～注目品目総数まで転記

２つめのマクロ：
ピボットテーブルで実現可能ですが、マクロで同様の動作を実現。
何の値を集計したいのか、ユーザに選択してもらう
dataシートにあるデータを一気に配列に格納
graphシートに必要なデータを以下のように転記

表の軸を作成（セルB1から横へ日付、A2から下へ商品番号）
表の中は、集計したい値を転記
　
20-10-1　　20-10-2　　20-10-3・・・
A123
A456
A789
・
・
・

今回、グラフ作成のマクロはつけていません。

【感想】
結局書き直してみた所、発展２の知識だけで書くことができました。
マクロ作成が簡単なので便利だと思いました。(^^)

2021/01/22 11:30

たかちゃんさんのコメント

(コメントID: 7123)

CSVデータをまとめるマクロ

Option Explicit

'dataという名前のワークシートを予め作成しておいて下さい
Public Sub PasteCsvData()
    Dim fs As New Scripting.FileSystemObject
    Dim file As Scripting.file
    Dim files As Scripting.files
    Dim vlist() As Variant
    Dim gyo As Long
    Dim cnt As Long 'カウント用
    cnt = 1
    Dim wsData As Worksheet 'csvデータ書き込み先
    Dim fName As String
    
    Set wsData = Workbooks("BusinessReport.xlsm").Worksheets("data")
    
    
    '-----------------------------------------
    
     MsgBox "CSVファイルが保存されているフォルダを選択してください。"
    '[1]FileDialogオブジェクトを使う方法
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Set files = fs.GetFolder(.SelectedItems(1)).files
        Else
            Exit Sub
        End If
    End With
    '[2]ファイル拡張子でcsvを判定
    For Each file In files
        If LCase(fs.GetExtensionName(file)) <> "csv" Then
            MsgBox "CSVファイル以外のファイルが含まれるため実行できません。"
            Exit Sub
        End If
    Next
    
  '-----------------------------------------
    
    For Each file In files
        
        'ファイルを開く
        Workbooks.Open (file)
        
        fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得

        'csvデータを配列に格納し、その後書き出す
        gyo = wsData.Range("B" & Rows.Count).End(xlUp).Row

        '1回目はタイトル行含む
        If cnt = 1 Then
            vlist = Range("A1").CurrentRegion
            wsData.Range("B1").Resize(UBound(vlist, 1), UBound(vlist, 2)).Value = vlist
            wsData.Range("A1").Value = "日付"
            wsData.Range("A2" & ":A" & wsData.Range("B" & Rows.Count).End(xlUp).Row).Value = fName
        Else
        '2回目以降はタイトル行を除く
            vlist = Range("A1").CurrentRegion.Offset(1, 0).Resize(Range("A1").CurrentRegion.Offset(1, 0).Rows.Count - 1)
            wsData.Range("B" & gyo + 1).Resize(UBound(vlist, 1), UBound(vlist, 2)).Value = vlist
            wsData.Range("A" & gyo + 1 & ":A" & wsData.Range("B" & Rows.Count).End(xlUp).Row).Value = fName
        End If
        ActiveWorkbook.Close
        cnt = cnt + 1
    Next
    
   Set file = Nothing
   Set fs = Nothing
    
End Sub

2021/01/22 11:33

たかちゃんさんのコメント

(コメントID: 7124)

ピボットテーブルのような動きのマクロ

Option Explicit

    Dim wsSaki As Worksheet
    Dim wsMoto As Worksheet
    
Public Sub CreateGraph()
    Dim ar() As Variant
    Dim ans As Long '調べたいデータ
    
    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    ans = InputBox("数字を入力して下さい" & vbCrLf & "セッション：5" & _
    vbCrLf & "ページビュー：7" & vbCrLf & "カートボックス獲得率：9" & _
    vbCrLf & "商品購入率：11" & vbCrLf & "注文商品売上：12", "データ集計", "")


    If ans <> 5 And ans <> 7 And ans <> 9 And ans <> 11 And ans <> 12 Then
        MsgBox "集計できません"
        Exit Sub
    End If

    '初期化
    wsSaki.Range("A1").CurrentRegion.ClearContents
    '横軸（日付）の書き出し
    ar() = CreateAxis("A", "B")
    '貼り付け
    wsSaki.Range("A1").Resize(UBound(ar, 2), UBound(ar, 1)).Value = _
    Application.WorksheetFunction.Transpose(ar)
    
    Erase ar
    
    '縦軸（商品番号）の書き出し
    ar() = CreateAxis("C", "B")
    '貼り付け
    wsSaki.Range("A1").Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar
    
    '値を表の中に書き出し
    CreateValue ans
    
End Sub

Private Sub CreateValue(ans As Long)

    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    Dim vlist As Variant
    Dim Col As Long
    Dim Lrow As Long
    Dim c As Long
    Dim gyo As Long
    Dim retsu As Long
    
    'データを一気に配列に格納
    vlist = wsMoto.Range("A1").CurrentRegion
    '最終列を調査
    Col = wsSaki.Range("A1").End(xlToRight).Column - 2
    '最終行を調査
    Lrow = wsSaki.Range("A" & Rows.Count).End(xlUp).Row - 2
    
    For c = LBound(vlist, 1) + 1 To UBound(vlist, 1)
        For gyo = 0 To Lrow
        If Range("A2").Offset(gyo).Value = vlist(c, 3) Then
            For retsu = 0 To Col
            If Range("B1").Offset(, retsu).Value = vlist(c, 1) Then
                Range("B2").Offset(gyo, retsu).Value = vlist(c, ans) '調べたい値が入力
                Exit For
            End If
            Next
        Exit For
        End If
        Next
    Next

    
End Sub

Function CreateAxis(R1 As String, R2 As String) As Variant()
    Dim arDate() As Variant

    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    Dim lastR As Long
    
    'データをコピーし貼り付け
    lastR = wsMoto.Range(R1 & Rows.Count).End(xlUp).Row
    'A列日付の貼り付け
    wsMoto.Range(R1 & "1:" & R1 & lastR).Copy
    'とりあえず関係無い所B3に書き出している
    wsSaki.Range(R2 & "3").PasteSpecial xlPasteValues
    
    '重複データを除去
    lastR = wsSaki.Range(R2 & Rows.Count).End(xlUp).Row
    wsSaki.Range(R2 & "3:" & R2 & lastR).RemoveDuplicates Columns:=1, Header:=xlYes
    
    '配列に格納
    lastR = wsSaki.Range(R2 & Rows.Count).End(xlUp).Row
    arDate = wsSaki.Range(R2 & "3:" & R2 & lastR).Value
    wsSaki.Range(R2 & "3:" & R2 & lastR).ClearContents
    
    CreateAxis = arDate()
    
End Function

2021/01/22 11:38

小川慶一さんのコメント

(コメントID: 7125)

たかちゃんさん:

相変わらず、すばらしいですね。

参考までに紹介すると、条件設定しての値取得には、ワークシート関数のDSum DCount 等のデータベース関数群が便利です。

これらの関数は、エクセルVBAからも利用可能です。
以下は、サンプルコードです。
(*サンプルデータの取得は、サンプルコードの後に紹介したリンクからお願いします)

配列の要素はハードコーディングしていますが、実務では、紹介済みの重複しないリストを作成する方法等で動的に取得することになるでしょう。
条件設定をしているセル(I1:K2)は、ユーザから見えないところに置くか、コード内で生成して出力が終わったら削除するか。

Sub dsum_sample()
    Dim rData As Range, rCondition As Range
    Set rData = Range("A1").CurrentRegion
    Set rCondition = Range("I1").CurrentRegion
    
    'DSum関数をworksheetfunctionで使うための動作確認(セルN2に埋め込んだ関数式も参考のこと)
    Debug.Print WorksheetFunction.DSum(rData, "仕入金額", rCondition)
    
    Dim i As Integer, j As Integer, k As Integer
    Dim iYear(1) As Integer, iMonth(11) As Integer, sShohin(2) As String
    iYear(0) = 2005
    iYear(1) = 2006

    For j = LBound(iMonth) To UBound(iMonth)
        iMonth(j) = j + 1
    Next

    sShohin(0) = "あま酒"
    sShohin(1) = "ふりかけ"
    sShohin(2) = "みそピー"

    
    Dim gyo As Integer
    Const cBase As Long = 6
    
    '仕入年ごとの仕入額総計
    gyo = cBase
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        Range("I" & gyo).Value = iYear(i) & "年"
        Range("J" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
        gyo = cBase + 1
    Next

    '仕入年ごと、商品ごとの仕入額総計
    gyo = gyo + 2
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        For k = LBound(sShohin) To UBound(sShohin)
            Range("K2").Value = sShohin(k)
            Range("I" & gyo).Value = iYear(i) & "年"
            Range("J" & gyo).Value = sShohin(k)
            Range("K" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
            gyo = gyo + 1
        Next
    Next

    '仕入年月ごと、商品ごとの仕入額総計
    gyo = gyo + 2
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        For j = LBound(iMonth) To UBound(iMonth)
            Range("J2").Value = iMonth(j)
            For k = LBound(sShohin) To UBound(sShohin)
                Range("K2").Value = sShohin(k)
                Range("I" & gyo).Value = iYear(i) & "年"
                Range("J" & gyo).Value = iMonth(j) & "月"
                Range("K" & gyo).Value = sShohin(k)
                Range("L" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
                gyo = gyo + 1
            Next
        Next
    Next
End Sub

https://www.dropbox.com/s/5tskwgme88cdm22/dsum_sample.xlsm?dl=0

2021/01/22 20:16

田中宏明さんのコメント

(コメントID: 7126)

たかちゃん

> 相変わらず、すばらしいですね。
ホントすばらしです。

私からは、他人がツールを使う場合の対策を紹介します。
Application.InputBox　だと　Type:=1 指定で、数字だけを受け付けるようにできます。
ただし、キャンセルの場合、Falseが返るので、Variant型に変更したうえでVarTypeメソッドで変数のデータ型の分類を含む Integer 値を調べ、キャンセルを判定させています。

    Dim ans As Variant 'キャンセル対応でVariant型に変更
    ans = Application.InputBox(Prompt:="数字を入力して下さい" & vbCrLf & "セッション：5" & _
    vbCrLf & "ページビュー：7" & vbCrLf & "カートボックス獲得率：9" & _
    vbCrLf & "商品購入率：11" & vbCrLf & "注文商品売上：12", Title:="データ集計", Type:=1)
 
    If VarType(ans) = vbBoolean Then
        MsgBox "キャンセルされました。"
        Exit Sub
    ElseIf ans <> 5 And ans <> 7 And ans <> 9 And ans <> 11 And ans <> 12 Then
        MsgBox "集計できません"
        Exit Sub
    End If

　…途中略…

    '値を表の中に書き出し
    CreateValue CLng(ans)  'Long型にキャストして渡す必要あり

2021/01/23 07:12

たかちゃんさんのコメント

(コメントID: 7127)

小川慶一さん:

先生、サンプルコード読みました。
読み終わった時は、凄すぎて言葉が出ませんでした。

Excelがここまで凄かったとは・・。
サンプルコードは、まさに実現したかった事です。
エクセルの標準機能もイチから勉強し直します。
毎回、本当にありがとうございます！

> 参考までに紹介すると、条件設定しての値取得には、ワークシート関数のDSum DCount 等のデータベース関数群が便利です。

2021/01/23 09:37

たかちゃんさんのコメント

(コメントID: 7128)

田中宏明さん:

ありがとうございます！
実はキャンセル判定ずっと方法を考えていたのですが
答えを見つけられずにいました。。

こうやって、VBA業務の経験者とやり取りできる機会を与えてもらい
感謝しかありません。早速、試してみます！

> 私からは、他人がツールを使う場合の対策を紹介します。
> Application.InputBox　だと　Type:=1 指定で、数字だけを受け付けるようにできます。
> ただし、キャンセルの場合、Falseが返るので、Variant型に変更したうえでVarTypeメソッドで変数のデータ型の分類を含む Integer 値を調べ、キャンセルを判定させています。

2021/01/23 09:46

小川慶一さんのコメント

(コメントID: 7129)

田中宏明さん:

興味深いです。

intputbox と excel の application.inputbox は別物なんですね。
Type:=1 て、正直、はじめてこの引数の存在を認識しました。

InputBox 関数
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/inputbox-function

Application.InputBox メソッド (Excel)
https://docs.microsoft.com/ja-jp/office/vba/api/excel.application.inputbox

Inputboxでは、「想定内の値が入力されるまでしつこくダイアログを表示したい」というのもよくあるニーズです。
そういうときは、 Do Loop 内にinputbox表示のコードを入れて、所望の値を入力されるまでLoopをくり返すというやり方もあります。

ということで、以下、少しリライトしてみました。

もっとも、しっかり作り込むなら、ユーザフォームを作って、有効な選択肢のみをラジオボタン表示するのが良いでしょう。

Sub hoge()
    Dim ret As Variant
    Dim bOk As Boolean
    bOk = False
    Do
        ret = Application.InputBox(Prompt:="5, 7, 9, 11, 12 のどれかを入力してください", Type:=1)
        Select Case LCase(TypeName(ret))
            Case "boolean"
                MsgBox "キャンセルされました"
                Exit Sub
            Case Else ' "double"
                Select Case CInt(ret)
                    Case 5, 7, 9, 11, 12
                        bOk = True
                    Case Else
                        bOk = False
                End Select
            End Select
    Loop Until bOk
    Debug.Print ret
End Sub

'メインの処理を簡潔にしたバージョン
Sub fuga()
    Const prompt_string As String = "5, 7, 9, 11, 12 のどれかを入力してください"
    Dim ret As Variant
    Do
        ret = Application.InputBox(Prompt:=prompt_string, Type:=1)
        If TypeName(ret) = "Boolean" Then
            MsgBox "キャンセルされました"
            Exit Sub
        End If
    Loop Until is_valid(ret)
    Debug.Print ret
End Sub
Function is_valid(ret As Variant) As Boolean
    Select Case ret
        Case 5, 7, 9, 11, 12
            is_valid = True
        Case Else
            is_valid = False
    End Select
End Function

2021/01/23 23:13

田中宏明さんのコメント

(コメントID: 7131)

たかちゃんさん:

> エクセルの標準機能もイチから勉強し直します。
おかげさまでExcel標準のデータベース関数を勉強する機会を得ました。
条件設定した集計は、Excel標準のSumifs関数を先に知ったので、小川先生と同じ集計をSumifs関数で実装してみました。

Sub sumifs_sample()
    'SumIfs関数でDsum関数と同じことをしてみた by Tanaka
    Dim sfData As Range '仕入金額
    Dim rData1 As Range '仕入年
    Dim rData2 As Range '仕入月
    Dim rData3 As Range '商品名

    Set sfData = Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row)
    Set rData1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Set rData2 = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    Set rData3 = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
    
    Dim i As Integer, j As Integer, k As Integer
    Dim iYear(1) As Integer, iMonth(11) As Integer, sShohin(2) As String
    iYear(0) = 2005
    iYear(1) = 2006

    For j = LBound(iMonth) To UBound(iMonth)
        iMonth(j) = j + 1
    Next

    sShohin(0) = "あま酒"
    sShohin(1) = "ふりかけ"
    sShohin(2) = "みそピー"
    
    Dim gyo As Integer
    
    '仕入年月ごと、商品ごとの仕入額総計
    gyo = 6
    For i = LBound(iYear) To UBound(iYear)
        For j = LBound(iMonth) To UBound(iMonth)
            For k = LBound(sShohin) To UBound(sShohin)
                Range("I" & gyo).Value = iYear(i) & "年"
                Range("J" & gyo).Value = iMonth(j) & "月"
                Range("K" & gyo).Value = sShohin(k)
                Range("L" & gyo).Value = _
                WorksheetFunction.SumIfs(sfData, rData1, iYear(i), rData2, iMonth(j), rData3, sShohin(k))
                gyo = gyo + 1
            Next
        Next
    Next
End Sub

2021/01/24 18:14

たかちゃんさんのコメント

(コメントID: 7133)

田中宏明さん:

コード読みました！関数も組み合わせて使うと、最強ですね。
読むのも簡単ですし。(^^)

今回改めてエクセルの素晴らしさに気づきました。
標準機能については、割と知っている方だと思っていましたが
とんでもない誤解でした。(^^;;

早速、エクセルを使用したデータ分析について少し復習をしていました。
既に知っている関数でも使い方次第で、このような判定もできるんだと
気づきました。言われれば「なるほど！」と思いますが、
意外と思いつかないのです。

【例】
Countifを使って、セルの中に"株式会社"の文字が入っているか判定
含む場合は"1"、含まない場合は"0"
=countif(セル,"*株式会社*"))

> > エクセルの標準機能もイチから勉強し直します。
> おかげさまでExcel標準のデータベース関数を勉強する機会を得ました。
> 条件設定した集計は、Excel標準のSumifs関数を先に知ったので、小川先生と同じ集計をSumifs関数で実装してみました。

2021/01/25 06:36

田中宏明さんのコメント

(コメントID: 7134)

たかちゃんさん:

> コード読みました！関数も組み合わせて使うと、最強ですね。
Application.WorksheetFunctionでExcel関数を利用すると便利な場面は多くありますね。
一方、小川先生の講座は、VBA初学者がExcel関数に頼ることなく、最初は条件分岐や繰り返しのコードを学び、それを実践していくといった遠回りな方法かもしれませんが、確実に腕力をつけることを重視されており、Excel関数を利用する方法は、紹介程度に留めているのだと思います。

既にご存知の Countifは、重複のないリストを作成する場合にも使えますよ。
http://officetanaka.net/excel/vba/tips/tips182.htm

2021/01/25 06:56

たかちゃんさんのコメント

(コメントID: 7135)

田中宏明さん:
ありがとうございます。
重複しないリストだけでも、本当に色々な方法があるのですね。
VBAが書けると選択肢が増えて楽しいです。

> たかちゃんさん:
>
> > コード読みました！関数も組み合わせて使うと、最強ですね。
> Application.WorksheetFunctionでExcel関数を利用すると便利な場面は多くありますね。
> 一方、小川先生の講座は、VBA初学者がExcel関数に頼ることなく、最初は条件分岐や繰り返しのコードを学び、それを実践していくといった遠回りな方法かもしれませんが、確実に腕力をつけることを重視されており、Excel関数を利用する方法は、紹介程度に留めているのだと思います。
>
> 既にご存知の Countifは、重複のないリストを作成する場合にも使えますよ。
> http://officetanaka.net/excel/vba/tips/tips182.htm

2021/01/25 11:48

小川慶一さんのコメント

(コメントID: 7139)

田中宏明さん、たかちゃんさん:

おはようございます。

ありがとうございます。
DSumよりSumIfsのほうが計算のためにセルに条件を記載する必要がない分良さそうですね。

> 一方、小川先生の講座は、...、最初は条件分岐や繰り返しのコードを学び

これは、ホントそうです。
便利なショートカット技をどんなにたくさん知ったとしても、条件分岐や繰り返しのコードからは逃げられないです。
一方、条件分岐や繰り返しのコードをきちんと書けると、ショートカット技を知らなくてもたいていの計算は自力でできます。

2021/01/27 17:31