質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.10%

VBAでシートの情報を自動で配列化したい

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 1,175

score 12

前提・実現したいこと

エクセルファイルをVBAで操作したい

<前提>
①:対象のエクセルのシート数・データ数は都度変わる
②:エクセルのA3からH(n)までの情報を取得し、配列化したい

発生している問題

配列は作れたものの、各シートの情報を格納したものではなく、
対象のブックが開かれたときにアクティブになるシートの情報しか得られません。
例として、シート1は範囲がA3~H99までとしたとき、範囲が(97,8)となる配列は作れるものの、
配列の中身がシート3だったり4だったりしています。
初心者なのできっとしょうもない過ちを犯しているのでしょうが、
調べてみても解決策は見出せませんでした。

該当のソースコード

Sub testMain() 
    Dim fName As String 'ファイルネーム 
    Dim wb As Workbook 'ワークブックオブジェクト 
    Dim sCount As Integer 'シート数 

    MsgBox "操作したいファイルは予め保存の上閉じてください" 

    ' ファイルを開くダイアログ表示 
    fName = Application.GetOpenFilename(",*.xlsx") 
    ' ワークブックを開く 
    Set wb = Workbooks.Open(fName) 
    '対象のワークブックのワークシート数を取得する 
    sCount = wb.Worksheets.Count 

    '取得したシート数分処理を繰り返す 
    Dim i As Integer 
    For i = 1 To sCount 
        'ループの中でSubを実行 
        Call testSub(i, wb) 

    Next i 

    MsgBox "完了しました" 
End Sub 
■■■■■■ 
Private Sub testSub(i, wb) 
    Dim rCount As Long '行数 

    'iシート目のワークシートオブジェクトの行数を取得する 
    rCount = wb.Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row 

    '配列を用意 
    Dim arr() As Variant 
    With wb.Worksheets(i) 
    'arr(rCount-2,8)の配列を作る
    arr = Range("A3:H" & rCount) 
    End With 

    'MsgBoxで試しに出力してみたところ、範囲はiシート目のものだが、中身の情報が全て特定の1シートになっている。
    MsgBox arr(rCount - 2, 3) 
  
End Sub 

試したこと

範囲を配列に代入する際、
arr = wb.Worksheets(i).Range("A3:H" & rCount)
とした所”型が一致しません”のエラーが出てしまいます。

補足情報

前提で書いた処理が面倒でVBAに手を出した初心者なので、
試したことの情報が少なく恐縮です。
上のコードもまだ完成形ではなく、最終的には配列内の要素同士を比較し、
結果を別配列に格納する下記のような処理を自動で行うマクロが作りたいです。
If arr(i,2)<>arr(i-1,2) Then
arrA(i) = 0
End If

wb.Worksheets(i).Range("B" & i ).Value<>wb.Worksheets(i).Range("B" & i-1).Value
のように直接比較するコードは書けたのですが、同様の処理を1行内で数個所行い、
更にi=rCountとなるまで繰り返す必要があるので、1シートの処理に数分かかる有様でとても使い物になりません。
皆様の知恵をお借りしたく投稿いたしました。知恵をお貸しください。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

checkベストアンサー

+1

以下2点修正してみてください。

  1. Dim arr() As Variant を Dim arr As Variant にする → hatena19さんのご指摘より、修正の必要がないことがわかりました。誤情報を書いてしまい申し訳ありません。
    rangeの範囲の中身を配列に代入するときに、変数宣言で()を付ける必要はなかったかと思います。
  2. Range("A3:H" & rCount) を .Range("A3:H" & rCount) にする
    .をつけないとWithステートメントの意味がありません。
    Range("A3:H" & rCount)はアクティブシートのRangeを指しているため、アクティブなシートの情報しか得られないのです。.をつけることで、Withの後に指定したもの(今回ならwb.Worksheets(i)を省略しますよ、という意味になります。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/09 00:07

    リンク先の後の方に解説がありますが、
    () がないと Variant型の中にVariant1型配列が格納される
    () があると、Variant型の動的配列になる
    ということがローカルウィンドウで確認できます。

    キャンセル

  • 2019/03/09 00:28

    Variant型の変数にVariant型(他の型でもいいですが)の配列そのものを格納できる、というのがリファレンスに書かれていることを期待したのですが、自分の探した範囲ではそれをはっきり書いた記述が見つかりませんでした。(リンク先に「実際には参照ポインタだと思う。」と書かれていますがその辺りも関係しているのでしょうか…)

    キャンセル

  • 2019/03/09 11:42

    そのものズバリなご指摘ありがとうございます!
    Withステートメントも見様見真似で使っていたので言われるまで全く気が付きませんでした。

    キャンセル

+1

こんな感じにしたらどうだろうか?
参考になれば、、、、

Option Explicit

Sub testMain()
    Dim wbTarget As Workbook        '操作対象のワークブックオブジェクト
    Dim ws As Worksheet             '各シート
    Dim sResult As String           '結果を文字列で記録(カンマ区切り)
    dim v                           '配列の受け皿

    On Error Resume Next
    Set wbTarget = GetBook(Application.GetOpenFilename(",*.xlsx"))
    On Error GoTo 0
    If wbTarget Is Nothing Then Exit Sub

    '取得したブックのシート数分処理を繰り返す
    For Each ws In wbTarget.Worksheets
        GetRowsCount ws, sResult
    Next

    MsgBox Mid(sResult, 2)
    v = Split(Mid(sResult, 2),",")
    Stop
End Sub

'=======================================================================
Private Function GetRowsCount(ByRef ws As Worksheet, ByRef s As String)
    With ws.UsedRange
        s = s & "," & .Cells(.Cells.CountLarge).Row
    End With
End Function

'========================================================================
Private Function GetBook(ByVal sFullPath As String) As Workbook
    Dim wb As Workbook
    Dim sFName As String
    Dim i As Long

    If sFullPath = "FALSE" Then Exit Function

    i = InStrRev(sFullPath, "\")
    sFName = Mid(sFullPath, i + 1)

    On Error Resume Next
    Set wb = Workbooks(sFName)
    On Error GoTo 0
    If wb Is Nothing Or wb.FullName <> sFullPath Then
        If sFName = wb.Name Then wb.Close True
        Set wb = Workbooks.Open(sFullPath)
    End If

    Set GetBook = wb
End Function

シートの全部のセルが空白だとエラーになるのだろうか。。。。動作確認してません。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/09 12:05

    ちょっと理解するのに時間がかかりました。。
    詳細なお手本を記載いただき感謝します。
    まだまだ完成形には遠いので参考にさせていただきます!

    キャンセル

+1

アクティブなシートしか対象にならない原因は、nmoaさんの回答どおりだと思います。

testSub の引数を i(インデックス), wb(WorkBook) とせずに、
対象のWorkSheetにすればシンプルになります。

Sub testMain() 
    Dim fName As String 'ファイルネーム 
    Dim wb As Workbook 'ワークブックオブジェクト 
    Dim sCount As Integer 'シート数 

    MsgBox "操作したいファイルは予め保存の上閉じてください" 

    ' ファイルを開くダイアログ表示 
    fName = Application.GetOpenFilename(",*.xlsx") 
    ' ワークブックを開く 
    Set wb = Workbooks.Open(fName) 

    Dim ws As WorkSheet
    For Each ws In  wb.Worksheets
        'ループの中でSubを実行 
        Call testSub(ws) 
    Next i 

    MsgBox "完了しました" 
End Sub 

Private Sub testSub(ByRef ws As WorkSheet)

    Dim rCount As Long '行数 
    'ワークシートオブジェクトの行数を取得する 
    rCount = ws.Cells(Rows.Count, 1).End(xlUp).Row 

    '配列を用意 
    Dim arr() As Variant 
    'arr(rCount-2,8)の配列を作る
    arr = ws.Range("A3:H" & rCount).Value

End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/03/09 11:47

    アドバイスありがとうございます!
    引数でWorksheets(i)は渡せないよなあと思ってましたがこうすればよかったんですね。
    引数をwsだけにすればたしかにtestSubもかなりすっきり書けそうです。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.10%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る