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

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

ただいまの
回答率

87.95%

CSVファイル内の複数レコードを取得したいが1レコード(1対のヘッダと値)しか取得できない

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 442

score 10

前提・実現したいこと

取込ボタン押下時に、フォルダに格納されているCSVファイルを選択し、CSVファイル内のデータ(項目名とデータ)を取得したいのですが、CSVファイルに複数レコード存在する場合に1レコードしか取得できません。
(取得できているのかもしれませんが、取得シートに1レコード(1対のヘッダと値)しか表示されません。)
複数レコードを取得するためにはどのように修正すべきかご教授いただけませんでしょうか。
また、複数レコードが取得できる場合に、取得できるレコード数に上限を儲けたい場合(レコードが6件以上ある場合は、5レコードまでしか取得しない、など)はどのように機能追加したらよろしいでしょうか。

例えば、以下のデータがCSVファイルに格納されている場合に、IDが01~05のレコードのみ取得したいです。(ID:06は取得しない。)

ID Name   Address Age
01 Sato   Tokyo   30
02 Kato   Chiba   40
03 Ito    Nara    25
04 Suzuki Kyoto   35
05 Kimura Shiga   45
06 Tanaka Akita   50

アドバイスをいただけませんでしょうか。
乱文で申し訳ございません。
どうぞ、よろしくお願いいたします。

発生している問題・エラーメッセージ

CSVファイルに複数レコードがある場合でも、1レコードしか取得できない
### 該当のソースコード
Sub 取込_Before_Click()

    Dim wsData As Worksheet
    Set wsData = Worksheets("取込")

    ' 前に設定した値をクリア
    wsData.Range("A1:Z1000").ClearContents

    Dim arrayPath As Variant
    Dim intFree As Integer
    Dim strRec As String
    Dim strSplit() As String
    Dim intColCount As Integer
    Dim intRowCount As Integer

    'ダイアログから複数のブックを選択し、配列にパスを格納する
    arrayPath = Application.GetOpenFilename("CSVファイル(*.csv), *.csv", MultiSelect:=True)

    If IsArray(arrayPath) Then

        Application.ScreenUpdating = False

        Dim intCurrentCol As Integer

        Dim i As Integer

        For i = 1 To UBound(arrayPath)

            Dim j As Long, k As Long

            '空番号を取得
            intFree = FreeFile

            'CSVファイルをオープン
            Open arrayPath(i) For Input As #intFree

            j = 0
            k = 0

            Do Until EOF(intFree)
                Line Input #intFree, strRec
                j = j + 1
                intRowCount = intRowCount + 1
                strSplit = Split(strRec, ",")

                For k = 0 To UBound(strSplit)
                    wsData.Cells(j, intColCount + k + 1) = strSplit(k)
                Next
            Loop

            intColCount = intColCount + UBound(strSplit) + 2


            Close #intFree
        Next i

        '読み込んだ内容をコピーして貼り付ける
        Dim copyRange As Range
        Set copyRange = wsData.Range(wsData.Cells(1, 1), wsData.Cells(intRowCount, intColCount))

        copyRange.Copy

        '読み込んだデータの下に行列入れ替えて貼り付ける
        wsData.Cells(intRowCount + 1, 1).PasteSpecial xlPasteValues, Transpose:=True

        'コピー元の値をすべてクリアする
        opyRange.ClearContents

        'クリアした空き行を詰める
        wsData.Range("1:" & intRowCount).Delete Shift:=xlUp

        '選択状態を解除
        wsData.Activate
        wsData.Range("A1").Select

        Application.ScreenUpdating = True

        Worksheets("Before").Range("B2:C1000").ClearContents

        Worksheets("取込").Range("A1:B1000").Copy
        Worksheets("Before").Range("B2").PasteSpecial Paste:=xlPasteValues

        wsData.Range("A1:Z1000").ClearContents

    End If

    Worksheets("フォーマット").Activate
    Worksheets("フォーマット").Select

End Sub
ソースコード
  • 気になる質問をクリップする

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

質問への追記・修正、ベストアンサー選択の依頼

  • radames1000

    2020/09/25 10:36

    IDが05までを取得の件も解決しましたか?

    キャンセル

  • kuma_kuma_

    2020/09/26 06:38

    解決済みにしておいてもらえますか

    キャンセル

  • shogakusha

    2020/10/06 09:52

    radames1000様
    返信が遅くなり、申し訳ございません。
    一旦解決いたしました。
    ありがとうございました。

    キャンセル

回答 1

check解決した方法

0

アドバイスの通り、コピー範囲を拡張したところ、解決できました。
ありがとうございました。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

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

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

関連した質問

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

  • トップ
  • VBAに関する質問
  • CSVファイル内の複数レコードを取得したいが1レコード(1対のヘッダと値)しか取得できない