その他　昨日のまとめ（VBA） - ひろボックス　〜備忘録〜

コレクションの作成（Collectionオブジェクト）
http://www.moug.net/tech/exvba/0150076.html

配列よりコレクションを使うと良さそう。
addを使って追加するの簡単。値はfor eachで取り出そう。組み込もう。

複数行をまとめてコメントアウト
 http://www.relief.jp/itnote/archives/001067.php

複数行コメントアウト出来たらなと思っていたらありました。
ツールバーの編集のところから出来て安心です。

あと
http://www.simple-sys.com/blog/2008/04/07/314/

ここ見て重複しないセルのオブジェクトを取得したいというか
万単位以上のデータでなんとか早く検索して取得したいけれど。。
２分探索では２分の１しかならず
なんとかそれ以外の方法（ローカルによるものか、VBA自体で解決できる方法）を模索中です・・・

一応それようの途中も残しておいて後で変更追記しよう。

Function columnObjOut(str As String)

'重複するデータを除いて指定した列一覧を抽出
'要　列のデータソート済
'一覧結果をRangeオブジェクトの配列として返す
'
'参考URL
'http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_jyufuku.html
Dim sheetName As String
Dim column As String                    '一覧抽出対象列
Dim column1 As String                   '一覧抽出対象列基準セル
Dim columnSet As New Collection         '取得した一覧の配列
Dim cntSame As Integer                  '同コード数

'変数の設定
sheetName = "Sheet1"    'シート名の設定
column = str            '列の設定
'column1 = CStr(str & 1)
cntSame = 10                 '列の項目種別数

'上記の列一覧処理のように出来ないか検討
'現在は配列で取得する
Dim x, y
Dim cnt As Integer
    Dim myCnt As Long, myFlg As Boolean
    Dim i As Long, j As Long
        With Worksheets("Sheet1")
            x = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
        End With
        ReDim y(1 To UBound(x), 1 To 1)
        y(1, 1) = x(1, 1)
        myCnt = 1
        cnt = 0
        Debug.Print TypeName(x)
        For i = LBound(x) To UBound(x)
            myFlg = False
            For j = 1 To myCnt
                If x(i, 1) = y(j, 1) Then myFlg = True: Exit For
            Next j
            If myFlg = False Then myCnt = myCnt + 1: y(myCnt, 1) = x(i, 1)
        Next i
        With Worksheets("Sheet2")
            .Range("C:C").ClearContents
            Debug.Print TypeName(y)
            .Range("C1").Resize(UBound(y), 1) = y
        End With
        For Each c In y
            'Debug.Print c
            'ここに取り出し抽出。データ取り出した後すぐループ抜ける処理記述
        Next

'参考URL
'http://www.simple-sys.com/blog/2008/04/07/314/        
'Dim myDic As Object, myKey As Variant
'    Dim c As Variant, varData As Variant
'        Set myDic = CreateObject("Scripting.Dictionary")    'Dictonaryオブジェクト生成
'        With Worksheets(sheetName)
'            varData = .Range(column1, "A41")
'        End With
'        For Each c In varData
'            If Not c = Empty Then
'                If Not myDic.Exists(c) Then
'                    myDic.Add c, Null
'                End If
'            End If
'        Next
'        myKey = myDic.keys
'
'        For Each c In myKey
'            Debug.Print c
'        Next
'
'        Set myDic = Nothing
        
        
'    Dim lastgyou As Integer
'    Dim i As Integer
'    Dim j As Integer
'
'    Dim checkatai As String
'
'    'B列の最終行を求めます。
'   lastgyou = ActiveSheet.Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row
'
'    '1行目から最終行の前まで繰り返します。
'   For i = 1 To lastgyou - 1
'
'        'チェックする値を、checkataiに代入します。
'
'        checkatai = ActiveSheet.Cells(i, 2).Value
'
'        '今見てる行から、下をチェックします。
'       For j = i + 1 To lastgyou
'
'            'もし、値が同じであれば、
'           If checkatai = ActiveSheet.Cells(j, 2).Value Then
'
'                'その行を削除します
'               ActiveSheet.Rows(j).Delete
'
'                '最終行が１行減ったのでlastgyouの値を減らします。
'               lastgyou = lastgyou - 1
'
'                'チェックしている行を１行前に戻します。
'               j = j - 1
'
'            End If
'
'        Next j
'
'    Next i
End Function

かなり汚い。。