Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 7 Professional : Excel 2016)
データベース化
投稿日時: 17/07/03 18:15:20
投稿者: sunflower

お世話になります。
教えてください。
 
ID  氏名  利用施設A 利用施設B 利用施設C 利用施設D 利用施設E・・・・
001  あ    1      0     0     0     1
002  い    0      0     0     0     1
003  う    1      1     1     1     1
004  え    0      0     1     0     1
005  お    0      1     0     1     1


 
上記のようなデータが15000列×1000行くらいあります。
 
この情報を、
ID  氏名  利用施設
001  あ   利用施設A
001  あ   利用施設B
002  い   利用施設E
003  う   利用施設A
003  う   利用施設B
003  う   利用施設C
003  う   利用施設D
003  う   利用施設E
004  え   利用施設C
004  え   利用施設E
005  お   利用施設B
005  お   利用施設D
005  お   利用施設E
となるようにしたいのですが、ループさせると1時間かかっても処理が終わらず困っています。
 
データベース化する方法を教えてください。
よろしくお願いします。

回答
投稿日時: 17/07/03 18:25:15
投稿者: WinArrow
投稿者のウェブサイトに移動

>データベース化する方法を教えてください。
 
後者の表をデータベースといっているのですか?
 
>データベース化
要は、処理が早くなればよいのでは?
 
どのようなコードで実行しているのですか?
コードを掲示して、アドバイスをもらった方がよいでしょう。

回答
投稿日時: 17/07/03 22:28:31
投稿者: WinArrow
投稿者のウェブサイトに移動

取り敢えず、作ってみましたので、アップしておきます。
15,000列x1000行のようなデータを作成してないので、
早くなるかは、保証することはできませんが、
試しに実行してみては?
 
Sub Sample()
Dim ALIST, Ax1 As Long, AX2 As Long
Dim ACOUNT As Long
Dim BLIST, BX As Long
 
With Sheets("Sheet1")
Dim SUMCELL As Range
 
    Set SUMCELL = .Cells(.UsedRange.Rows.Count, "C").Offset(1).Resize(1, .UsedRange.Columns.Count - 2)
    Debug.Print SUMCELL.Address
    SUMCELL.Formula = "=SUM(C2:C" & .UsedRange.Rows.Count & ")"
    ACOUNT = WorksheetFunction.Sum(SUMCELL)
    SUMCELL.EntireRow.Delete
    ReDim BLIST(1 To ACOUNT, 1 To 3)
    ALIST = .UsedRange.Value
    BX = 0
    For Ax1 = LBound(ALIST) + 1 To UBound(ALIST)
        For AX2 = 3 To UBound(ALIST, 2)
            If ALIST(Ax1, AX2) = 1 Then
                BX = BX + 1
                BLIST(BX, 1) = ALIST(Ax1, 1)
                BLIST(BX, 2) = ALIST(Ax1, 2)
                BLIST(BX, 3) = ALIST(1, AX2)
            End If
        Next
    Next
End With
With Sheets("sheet2")
    .Columns("A").NumberFormatLocal = "@"
    .Range("A1").Value = ALIST(1, 1)
    .Range("B1").Value = ALIST(1, 2)
    .Range("C1").Value = Left$(ALIST(1, 3), Len(ALIST(1, 3)) - 1)
    .Range("A2").Resize(UBound(BLIST), 3).Value = BLIST
End With
 
End Sub

回答
投稿日時: 17/07/06 12:15:35
投稿者: fffsbnm

確認ですが、本当にVBA・マクロが必要ですか?
ピボットテーブルを使ってできませんかね?

回答
投稿日時: 17/07/06 13:57:18
投稿者: mattuwan44

>ループさせると1時間かかっても処理が終わらず困っています。
個々のセルをいちいち個々に読み書きすると時間が掛かります。
こういう場合は、セルの読み書きを最小限にし、
配列変数に代入してその中で加工します。
 
Sub Crosstabs2List()
    Dim vntTabs As Variant '元のクロス集計表を代入
    Dim i As Long
    Dim ixH As Long
    Dim ixV As Long
    Dim vntResult() As Variant 'リスト形式に出力
 
    With Sheets("Sheet1").Range("A1").CurrentRegion
        vntTabs = .Value
        With Intersect(.Cells, .Offset(1, 2))
            ReDim vntResult(1 To .CountLarge, 1 To 3)
        End With
    End With
 
    For ixH = LBound(vntTabs, 1) + 1 To UBound(vntTabs, 1)
        For ixV = LBound(vntTabs, 2) + 2 To UBound(vntTabs, 2)
            If vntTabs(ixH, ixV) = 1 Then
                i = i + 1
                vntResult(i, 1) = vntTabs(ixH, 1)
                vntResult(i, 2) = vntTabs(ixH, 2)
                vntResult(i, 3) = vntTabs(1, ixV)
            End If
        Next
    Next
    Sheets("Sheet2").Range("A1").Resize(UBound(vntResult, 1), UBound(vntResult, 2)).Value = vntResult
End Sub
 
参考URL>>
http://officetanaka.net/excel/vba/speed/

投稿日時: 17/10/17 18:27:10
投稿者: sunflower

WinArrowさん、御礼が遅くなってしまい申し訳ございません。
>コードを掲示して、アドバイスをもらった方がよいでしょう。
おっしゃるとおりです。私が作成したコードは、単純なループで、
列の最終と行の最終になるまで永遠ループさせ、値が0なら、次の列。というのを
一行ごとに一列ずつ行う方法しか思いつかず、WinArrowさんな教えて頂いたコードを活用させて頂きました。
 
fffsbnmさん、御礼が遅くなってしまい申し訳ございません。
ピボットの作成過程をマクロで記録して・・・。と試みましたが、
ピボットで思うようなものにたどり着けませんでした。列や値の指定の仕方が悪いのでしょうか。
 
mattuwan44さん、御礼が遅くなってしまい申し訳ございません。
ありがとうございます。
 
WinArrowさん、mattuwan44さんに教えて頂いたコードで、実行してみたのですが、
データ量が多すぎるためか、ALIST = .UsedRange.Value や vntTabs = .Value で
メモリ不足のエラーとなってしまいました。
 
データ量を分割して作業するしかないでしょうか。
遅くなった上に追加の質問で申し訳ございませんが、お力を貸してください。
よろしくお願いいたします。

回答
投稿日時: 17/10/17 18:44:10
投稿者: WinArrow
投稿者のウェブサイトに移動

15000列
って、本当?
 
15000行x1000列の方が扱いやすいと思うが・・・、

回答
投稿日時: 17/10/17 20:26:13
投稿者: WinArrow
投稿者のウェブサイトに移動

こちらは、Excel2007の環境ですが
単純に、15,000列x1000行にデータを入れ込み
 
varCELL = Sheets(1).UsedRange.Value
 
を実行したが、メモリ不足にはなりません。
これだけの処理時間は、約3秒です。
 

回答
投稿日時: 17/10/17 20:33:58
投稿者: WinArrow
投稿者のウェブサイトに移動

↑のコードと実行結果
 
Sub test()
Dim varCELL, i As Long, j As Long
 
    Debug.Print Time
    varCELL = Sheets(1).UsedRange.Value
    Debug.Print Time
    Debug.Print UBound(varCELL) & "x" & UBound(varCELL, 2)
    For i = LBound(varCELL) To UBound(varCELL)
        For j = LBound(varCELL, 2) To UBound(varCELL, 2)
            If varCELL(i, j) = 0 Then Debug.Print varCELL(i, j)
        Next
    Next
    Debug.Print Time
End Sub
 
実行結果
20:31:48
20:31:51
1000x15001
20:31:53
 
 

回答
投稿日時: 17/10/17 21:04:12
投稿者: 菊りん0828

こんばんは。
お邪魔します。
 
>上記のようなデータが15000列×1000行くらいあります。
 
このセルには直接、「値」が入力されているのでしょうか?
「関数式」が入力されていると、ループの処理は著しく遅くなるなぁ
と感じた経験があります。
なんでだろう?
 
的外れでしたらすいません...m(_ _)m
 
 

回答
投稿日時: 17/10/17 21:19:20
投稿者: WinArrow
投稿者のウェブサイトに移動

>「関数式」が入力されていると、ループの処理は著しく遅くなるなぁ
> と感じた経験があります。
 
数式でも揮発性関数は、遅くなる可能性はあります。
数式が入っている場合、再計算を手動に切り替えてみたら?

回答
投稿日時: 17/10/18 08:48:03
投稿者: mattuwan44

>データ量を分割して作業するしかないでしょうか。
分割して出来るなら、分割してやればよいと思います。
1時間以上かかるってことはないと思いますので。。。。
 
15000行×1000列ってことは、
15000000行になる?
ってことは、1つのシートには収まらない?
 
それも考慮した方がいいかも?

回答
投稿日時: 17/10/18 10:48:57
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
15000行×1000列ってことは、
15000000行になる?

 
若し全件が該当すると1シートには入りきらないですね・・・
 
1シートの行数は、 1048576 行です。
 
ところで、この膨大なデータを、結局は並べ替えているわけですが、
どのような目的で使うのでしょうか?
 
単純に分割するよりは、目的を考えた分割にしないと、後で困ると思いますが・・・・
最初のレスにも書きましたが、
この処理ができたとして、結果の表をデータベースというからには、
データベースアプリケーションを使わないと、保存はもとより使うことすらできないでしょう。
運用環境の中にAccessは、ありますか?
この処理は1回だけですよね?(恒常的な処理ではない)

投稿日時: 17/10/18 15:37:36
投稿者: sunflower

WinArrowさん、菊りん0828さん、mattuwan44さんありがとうございます。
 
このデータは、別のシステムからはき出されたCSVデータです。
質問させていただいた当初は、1000行×15000列だったのですが、
最近データ量が増え、4000行×15000列まで膨れ上がってしまいました。
 
1000行以降のデータを削除して、やってみたところメモリ不足は発生しませんでした。
 
このデータ量(4000行×15000列)では難しいのですね。
 
データを並べ替えて、別で管理されている、IDに関する他の情報を
植えつけるようにしています。
 
Accessはあるのですが、Officeのバージョンが変更される際に互換のないものが多く、
職場では懸念されています。
 
また、この処理は年に1度の処理です。
お手数おかけしますが、アドバイスいただければ幸いです。
よろしくお願いいたします。

回答
投稿日時: 17/10/18 15:54:15
投稿者: mattuwan44

年1回なら、どこかで使ってないパソコンで、
その場その場で、使い捨てマクロ作って、
やらしちゃえばいいかなぁーと思わなくもないですが。。。
 
エクセルも当然定期的にバージョンアップしているわけで、
メンテナンスフリーでマクロが使えるどうか定かでないし、
会社ぐるみでマクロを開発&維持して作業効率UPを計っているならだけど、
個人で出来る人がたまたまやるなら、その人が居なくなったら困りますよね?
 
継続的にマクロを使いたいなら、業者に頼むべきだと思いますが。。。

回答
投稿日時: 17/10/18 16:28:27
投稿者: WinArrow
投稿者のウェブサイトに移動

>Accessはあるのですが、Officeのバージョンが変更される際に互換のないものが多く、
> 職場では懸念されています。
 
人それぞれとは思いますが、
私は、データの入物としてAccess2000のMDBファイルを使い、
Excel2007ですが、ExcelVBAでデータ更新、検索しています。
勿論、15000x4000のような多量ではありませんが・・・・
全件を使う処理はないと思いますので、
毛嫌いせずにデータだけでもAccessDBに登録するマクロを作成したらよいと思います。
CSVのフォーマットが提示のフォーマットでも構いませんが、
CSVデータの1件毎にDBに登録することができますから、
 
Do Until EOF(#FNO)
    LineInput #FNO,BUF
    data = Split(BUF,",") '<-- dataに配列(0〜15000)で入る
    For i = 2 To LBound(data)
       If data(i) <> 0 Then
           DB登録データ編集
   DB登録
       End If
    Next
Loop
 
こんな感じでシートを使わなくても処理できます。
 
データベース参照は、クエリを使えばよいと思います。
 
 

トピックに返信