えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

MENU
トップ > Excel > ExcelにGoogle Spreadsheetを読み込むVBA汎用関数を作ってみた

ExcelにGoogle Spreadsheetを読み込むVBA汎用関数を作ってみた

Excel VBA VBA汎用関数 Google Spreadsheet

今日はGoogle Spreadsheet（グーグルスプレッドシート：通称スプシ）に記載された表を、Excelに取り込むためのVBAを書いてみた。

きっかけ

最近になって、ようやくGoogle製品を本格的に使い始めたちゅんちゅん。

Googleフォーム　→　Google Spreadsheet　→　Google カレンダー等

という王道パターンでクラウドアプリを開発中の最中のことだ。

収集したデータをExcelに取り込みたくなってきた。

込み入った処理は慣れたVBAで処理したいからね。


検索してみると思った以上に情報がヒットしない。

ようやく見つけたと思ったら、不完全なコードばかりでがっかりした。

（いつものことだが、WEBの情報は）全く抽象化されていないのである。


というわけで、私なりに書き下ろしてみた。

最終行特定とか完全に私の趣味になっているが、気にしないように。


作ったもの

こんな感じのデータを

こう取り込める汎用関数を作成した。

今にして思えば、テーブル化してしまったほうが良いかもしれない。


ソースコード

早速ですがソースコードをドン！！！

Rem 2020/4/27
Rem Google SpreadsheetをExcelに取り込むVBA
Rem ことりちゅん
Option Explicit

Public Sub GS読み込みサンプル()

    Const URL = "https://docs.google.com/spreadsheets/d/1VtlH2Cde9SIOag1t0n8H4AeR4l00c47XHvskt77IW48/edit?usp=sharing"
    
    Rem 読み込み
    Dim rng As Range
    Set rng = ImportGoogleSpreadsheet(Sheet1, URL, False)
    
    Rem 出力範囲確認用
    rng.Select
    
    MsgBox "読込完了"
    
End Sub

Rem @funcname       ImportGoogleSpreadsheet
Rem
Rem @description    Google Spreadsheetのデータを指定したワークシートに読み込む
Rem
Rem @param ws       As Worksheet    取り込み先のワークシートオブジェクト
Rem @param GS_URL   As String       取り込み元のGoogle Spreadsheetの共有URL
Rem @param IsPlane  As Boolean      取り込み結果をそのままにするか（既定：False）
Rem
Rem @return         As Range        取り込まれたデータの入っているセル範囲
Rem
Public Function ImportGoogleSpreadsheet( _
        ws As Worksheet, _
        GS_URL As String, _
        Optional IsPlane As Boolean = False) As Range
    
    ws.Cells.Clear
    
    Dim 出力範囲 As Range
    Set 出力範囲 = ws.Range("A1")
   
    Dim tbl As QueryTable
    Set tbl = 出力範囲.Worksheet.QueryTables.Add( _
        Connection:="URL;" & GS_URL, Destination:=出力範囲)

    With tbl
        .RefreshPeriod = 0                  '自動タイマー更新を無効に
        .AdjustColumnWidth = True           '列幅自動調節
        .FillAdjacentFormulas = False       'クエリテーブルの右側の数式を自動的に更新しない
        .RefreshStyle = xlOverwriteCells    'セルのデータに上書き
        .WebFormatting = xlWebFormattingNone 'Web書式を無視
        .BackgroundQuery = False            'クエリを非同期で実行しない
        .Refresh                            'データソースと通信
'         .ResultRange.Select
        .Delete                             '処理後にオブジェクトを削除
    End With

    If Not IsPlane Then
        '最後の行から1行あけた下の3列目にシート名が列挙される。
        ws.Cells(ws.Rows.Count, 1).End(xlUp).Resize(100).EntireRow.Delete
        
        '先頭行列にはABCDE、12345が付与されるが、GSでウィンドウ枠の分割がされていると空白になる。
        Dim firstEmptyRC: firstEmptyRC = GetFirstEmptyRowCol(ws)
        ws.Rows(firstEmptyRC(1)).Delete
        ws.Columns(firstEmptyRC(2)).Delete
        
        'GSの行列全てを読み込むため、無駄な行列が後ろに続く。
        ws.Rows(1).Delete
        ws.Columns(1).Delete
    End If
    
    Set ImportGoogleSpreadsheet = ReallyUsedRange(ws)
    
End Function

Rem 最初に出現する空白行列の番号を返す。
Rem 主にGSから取得したテーブルのウィンドウ枠固定位置を特定するのに使用する。
Rem 3列目のシート名の出力位置に注意されたし。
Rem スプシの行列数＞Excelの行列数は想定していない。
Public Function GetFirstEmptyRowCol(ByVal ws As Worksheet) As Long()

    ReDim ret(1 To 2) As Long
    Dim i As Long, j As Long
    
    With ws.UsedRange
    
        Dim items(1 To 2) As Variant
        Set items(1) = .Rows
        Set items(2) = .Columns
        
        'CountAで行毎、列毎に検索
        For j = 1 To 2
            For i = 1 To items(j).Count Step 1
                If WorksheetFunction.CountA(items(j)(i)) = 0 Then
                    ret(j) = i
                    Exit For
                End If
            Next
        Next
        
        '未発見時使用範囲外
        If ret(1) = 0 Then ret(1) = .Rows.Count + 1
        If ret(2) = 0 Then ret(2) = .Columns.Count + 1
        
    End With
    
    GetFirstEmptyRowCol = ret()
    
End Function

Rem 本当に使用中のセル範囲を返す
Public Function ReallyUsedRange(ByVal ws As Worksheet) As Range
    Dim finRC: finRC = GetFinalRowCol(ws)
    Set ReallyUsedRange = ws.Cells(1, 1).Resize(finRC(1), finRC(2))
End Function

Rem ret(1)=最終行 ret(2)=最終列を求める
Public Function GetFinalRowCol(ByVal ws As Worksheet) As Long()

    ReDim ret(1 To 2) As Long
    Dim i As Long, j As Long
    
    With ws.UsedRange
    
        Dim items(1 To 2) As Variant
        Set items(1) = .Rows
        Set items(2) = .Columns
        
        'CountAで行毎、列毎に検索
        For j = 1 To 2
            For i = items(j).Count To 1 Step -1
                If WorksheetFunction.CountA(items(j)(i)) > 0 Then
                    ret(j) = i
                    Exit For
                End If
            Next
        Next
        
        '開始位置加算
        If ret(1) > 0 Then ret(1) = ret(1) + .Row - 1
        If ret(2) > 0 Then ret(2) = ret(2) + .Column - 1
        
    End With
    
    GetFinalRowCol = ret()
    
End Function


解説とか

項目 引数名 型名 備考
@funcname ImportGoogleSpreadsheet
@description Google Spreadsheetのデータを指定したワークシートに読み込む
@param ws As Worksheet 取り込み先のワークシートオブジェクト
@param GS_URL As String 取り込み元のGoogle Spreadsheetの共有URL
@param IsPlane As Boolean 取り込み結果をそのままにするか（既定：False）
@return As Range 取り込まれたデータの入っているセル範囲


IsPlane=True（加工なしの場合どうなるか）

加工しないとこのようなデータになります。


このままでは使えませんので、IsPlane=Falseでは3つの工程でデータを使いやすいように加工しています。

  • 最後の行から1行あけた下の3列目にシート名が列挙される。
  • 先頭行列にはABCDE、12345が付与されるが、GSでウィンドウ枠の分割がされていると空白になる。
  • GSの行列全てを読み込むため、無駄な行列が後ろに続く。


問題とか

https://twitter.com/KotorinChunChun/status/1253598642969047040?s=20


特定のデータに限って読み込んだデータが文字化けしてしまう現象が発生した。解決方法はわからなかった。

再現用URL

https://docs.google.com/spreadsheets/d/1aj2-D-qStNjNO936s4HWusvxpTZ7y4A0VAwjqqebulU/

どこかを少しでも修正すると治ったりする。

文字化けの原因が分からないので、この方法を使い続けるのは正直不安が残る。

https://twitter.com/KotorinChunChun/status/1254757590921146369?s=20


2番目以降のシートを指定する方法が分からなかった。

下記記事の方法を使って、シートに直リンさせてみたがうまく行かなかった。

http://blog.flect.co.jp/labo/2013/07/google-spreadsh-7b42.html


URLの引数を変更することで、CSVファイルをダウンロードさせる方法を教えてもらった。これは次回ためしてみたい。

https://qiita.com/reikubonaga/items/8a6322efd353e08d5243

google spreadsheetを表示している時のURLは以下のようになっている

https://docs.google.com/spreadsheets/d/{sheet_id}/edit#gid={page_id}

csvでexportした時のurlを表示する時には、以下のようにexport?format=csvを追加する

https://docs.google.com/spreadsheets/d/{sheet_id}/export?format=csv&gid={page_id}


まとめ

とりあえず最低限のデータ読み込みには成功した。

しかし、原因不明なバグは怖いし、別シートが読めないのも問題だ。

CSVを吐き出す方法を教えてもらったので、早急に調査して導入を検討したい。

みんなスプシのデータをExcelに取り込むときどうしてるのかなぁ・・・

https://twitter.com/KotorinChunChun/status/1254769128935616513?s=20

以上

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)

プライバシーポリシー