Excel (VBA)

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

 
(指定なし : 指定なし)
配列内の行数取得について
投稿日時: 17/10/21 11:06:22
投稿者: ゆきもと

ご助言いただきたく投稿させていただきます。
 
内容としては、エクセルで作成した一覧表の各項目(複数列・複数行)から特定のキーで重複していないレコードを配列に格納し、それをCSVファイルにするというものですが、配列の行数取得方法がわからずCSVファイルが作成できない事態となっております。
 
以下がコードになります。
 
Option Explicit
Dim Gyo(2) As Long
Dim myFile As Variant
Dim myLRow(0) As Long
Dim a As Long
Dim b As Long
Dim Dic1 As Object
Dim Dic2 As Object
Dim Key As String
Dim Keys As Variant
Dim Item As String
 
Dim myDate(1 To 3) As Variant '固定配列
Dim myCsvF As String
Dim myFNum As Long
Dim myJcells(51) As String
Dim myRec As String
 
Sub CommandButton1_Click()
 
On Error GoTo errorhandler 'エラー発生時処理を中断する
On Error Resume Next
 
Application.ScreenUpdating = False
 
myFNum = FreeFile
Set Dic1 = CreateObject("scripting.dictionary")
Set Dic2 = CreateObject("wscript.shell")
myCsvF = ThisWorkbook.Path & "\登録_" & Format(Now, "yyyymmddhhnnss") & ".csv"
'//
'//重複しない○○及び○○をキーにして連想配列を作成
'//
With Sheet1
 
    myLRow(0) = .Cells(Rows.Count, 2).End(xlUp).Row
 
    For a = 3 To myLRow(0)
        '//○○及び○○をキーに指定
        Key = .Cells(a, 4).Value & .Cells(a, 5).Value
        '//配列に[○○]シートの列4から列51を格納
        For b = 4 To UBound(myJcells)
         
            myJcells(b - 4) = .Cells(a, b).Value
         
        Next b
        '//配列に格納した値を結合
        Item = Join(myJcells, "∞")
        '//重複しない○○及び○○をキーにアイテムを作成
        If Not Dic1.exists(Key) Then
     
            Dic1.Add Key, Item
     
        End If
     
    Next a
    '//アイテムをKeys配列に格納
    Keys = Split(Dic1(Key), "∞")
     
End With
 
Open myCsvF For Output As #myFNum
Gyo(0) = 1
'////
'////↓ここから
'////↓行数の取得方法がわからず、CSVファイルが作成されない。
'////
Do While Gyo(0) < UBound(Keys)
 
    myDate(1) = Keys(0)
    myDate(2) = Keys(1)
 
    Print #myFNum, Join(myDate, """, """)
    Gyo(0) = Gyo(0) + 1
 
Loop
Close #myFNum
 
Application.ScreenUpdating = True
 
'//エラー発生時、以下の処理に従う
Exit Sub
errorhandler:
MsgBox "エラー" & Err.Number & vbCr & Err.Description & vbCr & "作成者へご連絡ください。"
 
Application.ScreenUpdating = True
 
End Sub
 
何卒ご指導いただけますようお願い申し上げます。
 
以上

回答
投稿日時: 17/10/21 12:12:34
投稿者: sy

助言が欲しいなら、EXCELのバージョンくらいは書くのが、質問者としての最低限のマナーです。
次回も質問する事があるなら、必ず記載して下さい。
 
dictionary に格納されたデータ数は、dic1.count で求められます。
 
ただ非常に疑問なのが、何で dictionary やシーケンシャルライトを使って書き込んでるんですか?
 
重複を除いてCSVにするだけなら、Excelのバージョンが書いてないので、
2007以降なら重複の削除を実行して、CSV形式で保存。
2003以前なら、フィルターオプションで重複を削除して、CSV形式で保存。
どちらも2つの簡単な手順で出来ます。
 
dictionary やシーケンシャルライトの使い方の勉強とかですか?
勉強するなら、今からならシーケンシャルライトよりもファイルシステムオブジェクトを覚えた方が汎用性も将来性も高いので、そちらをお勧めします。
 

回答
投稿日時: 17/10/21 12:28:39
投稿者: simple

すでに適切なコメントを頂いていますが、つけたしです。
dictionaryからのデータの取り出しは下記のようにすればよいと思います。

Sub test()
    Dim dic  As Object
    Dim key  As Variant
        
    Set dic = CreateObject("Scripting.Dictionary")
    dic("a") = 100
    dic("b") = 200
    dic("c") = 300
    
    For Each key In dic
        Debug.Print key
        Debug.Print dic(key)
    Next
End Sub

参考にしてみて下さい。

回答
投稿日時: 17/10/21 18:35:47
投稿者: simple

コードを拝見すると改善するべきところが色々と目につきます。
最大の点は、CSVファイルにする対象が何かが不明なことです。
4列目と5列目のキーだけなのか、4列目以降の配列なのか。
そこから始める必要がありそうです。
 
確実な結果を得たいのでしたら、
syさんが指摘されている方法が適当だと思います。
dictionaryの勉強ということならそれもよいでしょうけど。

トピックに返信