あるセルにとって、最終行、列を返す

'rgStart 単一セル
'horv 縦か横か、デフォルト縦
'戻り値
'  縦の場合 0→エラー
'  横の場合 ""→エラー
Public Function getBounce(ByRef rgStart As Range, Optional ByVal horv As String = "V") As String
Dim blnVertical As Boolean
Dim rgBounce As Range
    blnVertical = IIf(UCase(horv) = "H", False, True)
    If blnVertical Then
        Set rgBounce = rgStart.Worksheet.Range(ConvertToLetter(rgStart.Column) & rgStart.Worksheet.Rows.Count).End(xlUp)
        If rgStart.Cells.Count > 1 Then
            getBounce = IIf(blnVertical, 0, "")
            Exit Function
        End If
        If rgStart.Value = "" And rgBounce.Row <= rgStart.Row Then
            getBounce = 0
        Else
            getBounce = rgBounce.Row
        End If
        Exit Function
    Else
        Set rgBounce = rgStart.Worksheet.Range(ConvertToLetter(rgStart.Worksheet.Columns.Count) & rgStart.Row).End(xlToLeft)
        If rgStart.Value = "" And rgBounce.Column <= rgStart.Column Then
            getBounce = ""
        Else
            getBounce = ConvertToLetter(rgBounce.Column)
        End If
        Exit Function
    End If
    
End Function


Function ConvertToLetter(iCol As Integer) As String
    ConvertToLetter = Split(Cells(1, iCol).Address, "$")(1)
End Function

大量データのCSVをソート方法

Excelのソート機能を使う方法

Dim wb As New Workbook
    Dim st As New Worksheet
    Dim sortField As Range
    Dim rg As Range

    'csvファイルを開く
    Set wb = Workbooks.Open("c:\abc.csv")

    'シートをセット（csvファイルはsheet1しかない）
    Set st = wb.Sheets(1)
    
    For Each rg In st.Range("1:1")
        If rg = "容器番号" Then 'ソートする列を探す
            Set sortField = rg
            Exit For
        End If
    Next
    'ソート(容器番号)
    st.UsedRange.Sort Key1:=sortField, Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin

大量のデータの時、65535行（excel2007以下）,100万？を超えた時

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source='c:\';" & _
                    "Extended Properties='Text;HDR=YES'"
    'c:\abc.csvというファイルをデータベーステーブルとして開く、「容器番号」という列を昇順でソート                
    Set rs = cn.Execute("SELECT * FROM abc.csv ORDER BY clng(容器番号) ASC")
    
    Do Until rs.EOF

       'データを書き出しなどの処理
       '...

       rs.MoveNext
    Loop

"HDR=YES"は最初の行はタイトルという意味。

ちなみに、下の順番にならないためには、

1
10
2
3
...

クエリーをこのようにclng関数を使う

SELECT * FROM abc.csv ORDER BY clng(容器番号) ASC

sqlではcastやconvertなど使いますが、Microsoft.Jet.OLEDB(Access)ではclngなどで文字列を数字に変換する

Excelのソートの話

Excel2007のソート

ActiveWorkbook.Worksheets("201210期").Sort.SortFields.Clear
    Worksheets("201210期").Sort.SortFields.Add Key:=Worksheets("201210期").Range("B4"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("201210期").Sort
        .SetRange Worksheets("201210期").Range("A5:CO90")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Range("B4")→並び替え列
Order:=xlAscending→昇順、xlDescending降順
.SetRange Range("A5:CO90")→並び替え範囲
.Header = xlNo→ヘッダーありなし(xlYes,xlNo)、xlGuessの利用は避けたほうが無難。

Excel XP(2002)のソート

Worksheets("201210期").Range("A5:CO90").Sort Key1:=Worksheets("201210期").Range("B4"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin

Excelは下位互換ですので、XPも2007も2010も使えるためには、excel xpのコードで実装したほうが無難

ランダム数字のcsvを作成するツール

固定でc:\abc.csvです

Sub csvRnd()
Dim txt As Integer
Dim lngidx As Long
Dim lngStart As Long
Dim lngEnd As Long

txt = FreeFile
Open "c:\abc.csv" For Output As #txt
Write #txt, "ID", "Name"

lngStart = 1
lngEnd = 120000
For lngidx = lngStart To lngEnd
    Write #txt, lngidx, Int((lngEnd - lngStart + 1) * Rnd + lngStart)
    
Next
Close #txt
MsgBox "completed!", vbInformation
End Sub

google apps engineでカスタマドメインいろいろメモ

ややこしくて、箇条書きでメモしていく
前提：
・有料はgoogle apps for businessサービスを利用している「abc.com」とします
・管理画面から「abc.com」の「google apps engine」(GAE)を開通
・GAEで「xyz-jp.appspot.com」というappを作成、URLはhttp://xyz-jp.appspot.comです
・ドメイン「xyz.com」をお名前.comから購入

やりたいこと：
・「xyz.com」をGAEのURLにする
・無料でやること


最初やったこと：
・DNSで「www」ホストで、タイプ「CNAME」で、値を「xyz-jp.sppspot.com」にしてみたが、「www.xyz.com」を叩くとgoogle.comのトップ画面に飛んでしまう、そう簡単ではないはず、GAEは登録されていないドメインに飛ばせない仕組みになっているみたい。

次考えた手は：
・「abc.com」のgoogle appsドメイン管理画面で、xyz.comを追加し
・指定のキーをDNSでTXTレコードとして登録し、xyz.comを所有していることを証明（浸透結構時間かかった）
　→nslookup -type=TXT xyz.comでキー登録されたがどうかを確認できる
・ここで一つビックリしたことを判明、有料ドメインabc.comにxyz.comを登録したら、xyz.comも有料になります！！！つまり、xyz.comでユーザを作成にはabc.comのライセンスを使うことになります！
　→google appsは10アカウント以下なら無料で使えるはずです。

解決1（結局ダメでした）方法と経緯：
・abc.comに1ライセンス余っているから、xyz.comの管理者「root@xyz.com」を取り敢えず作成して、管理画面からxyz.comを有料プランから無料プランに変更（できるかできないかやってみないと分からない）
・しかし、ユーザは作成したが、管理者にはならず、xyz.comの管理画面に入れない
・abc.comの管理画面からなんと「root@xyz.com」というユーザが見えない！ライセンスは使った状態でした。
・ここで止まった、カスタムサービスに電話した

解決2：
・カスタムサービスのお姉ちゃんによると、xyz.comは有料abc.comドメインの追加されて、xyz.comも有料扱い
・xyz.comはabc.comに属しているので、abc.comの管理画面では普通にxyz.comのユーザ見えて、管理できるはず
・しかし、見えないのはもしかしてバグ？
・お姉ちゃんにヒントもらって、アカウント検索で「root@xyz.com」を検索したらちゃんと出てきて、削除した
・abc.comからxyz.comを削除した
・再度普通のgoogle appsからxyz.comを追加、所有権を証明→xyz.com無料でgoogle apps利用できる状況に
・abc.comのGAE「xyz-jp.appspot.com」のapplication settingに「add domain」して「xyz.com」を追加
・「xyz.com」のgoogle apps登録画面が表示され、利用契約を同意して、DNSでホストに「www」を追加し、タイプ「CNAME」にしてで、値として「ghs.googlehosted.com」を登録
・浸透して、www.xyz.comをアクセスするとちゃんと表示された...
・ふーーっ！

感想：
1.有料GAにドメイン追加したら、そのドメインのGAも無条件に有料になる
2.GAのユーザ管理画面にバグがあった、アカウントが表示されないときは、検索してみて
3.今回はabc.comとxyz.com２つのドメインがあって、ややこしくなったけど、単一ドメインは簡単です

いやー、雑乱でゴメンナサイ...orz

再帰的（サブフォルダも含む）にあるディレクトリ配下のファイル一覧を取得、配列の結合（マージ）メッソドもセットで

バグがあったら、教えてくれるとありがたい
☆参照にscriptingは必要！☆
再帰的（サブフォルダも含む）にあるディレクトリ配下のファイル一覧を取得メッソド

Function ListUp(FolderSpec) As Variant

    Dim File_Collection As Object
    Dim File_List As Variant
    Dim Folder_Collection As Object
    Dim Folder_List As Variant
    Dim result As Variant
    Dim subResult As Variant
    Dim subResultAppend As Variant

    If Not CreateObject("Scripting.FileSystemObject").FolderExists(FolderSpec) Then
        ListUp = Empty
        Exit Function
    End If
    
    Set File_Collection = _
                     CreateObject("Scripting.FileSystemObject") _
                    .GetFolder(FolderSpec).Files
    

    For Each File_List In File_Collection
        push FolderSpec & "\" & File_List.Name, result
    Next
    
    Set Folder_Collection = _
                       CreateObject("Scripting.FileSystemObject") _
                      .GetFolder(FolderSpec).SubFolders
    
    For Each Folder_List In Folder_Collection
        subResultAppend = ListUp(FolderSpec & "\" & Folder_List.Name)
        subResult = ArrayMerge(subResultAppend, subResult, True)
    Next
    
    ListUp = ArrayMerge(subResult, result)
End Function

配列最後に要素を追加していくメッソド

'this is a function to push an element into an array
Public Function push(ByVal val As Variant, ByRef arr As Variant) As Integer
    If IsArray(arr) Then
        ReDim Preserve arr(UBound(arr) + 1)
    Else
        ReDim arr(0)
    End If
    arr(UBound(arr)) = val
    push = UBound(arr)
End Function

配列を結合するメソッド、追加（ダブリチェックなし）とマージ（ダブリチェックあり）モードあり、最後の引数は結語した後に、元配列を消す設定

Public Function ArrayMerge(ByRef sourceArray As Variant, ByRef destArray As Variant, Optional appendMode As Boolean = False, Optional KillSource As Boolean = False) As Variant
Dim sDic As New Scripting.Dictionary
Dim v As Variant
Dim tempArray As Variant
Dim idx As Long

'片方だけなら、片方を返す
If (Not IsArray(sourceArray)) And (Not IsArray(destArray)) Then
    ArrayMerge = Null
    Exit Function
ElseIf Not IsArray(sourceArray) Then
    ArrayMerge = destArray
    Exit Function
ElseIf Not IsArray(destArray) Then
    ArrayMerge = sourceArray
    Exit Function
End If

'ダブリチェックしない、ただ追加していくモード
If appendMode Then
    ReDim tempArray(UBound(sourceArray) + UBound(destArray) + 1)
    idx = 0
    For Each v In sourceArray
        tempArray(idx) = v
        idx = idx + 1
    Next
    For Each v In destArray
        tempArray(idx) = v
        idx = idx + 1
    Next
'ダブリチェックする、Mergeモード。ないものだけ追加していくモード
Else
    idx = 0
    For Each v In sourceArray
        sDic.Add v, idx
        idx = idx + 1
    Next
    
    For Each v In destArray
        If Not sDic.Exists(v) Then
            sDic.Add v, idx
            idx = idx + 1
        End If
    Next
    tempArray = sDic.Keys
End If
If KillSource = True Then Erase sourceArray
ArrayMerge = tempArray
End Function

使い方はこう、"c:\windows"みたいな深すぎフォルダーは使わないほうがいいね、timeoutっぽい

dim fileList as Variant
fileList = ListUp("c:\your_path")

urlのパラメータを取得するfunction、デフォルト指定もある

<!doctype html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
    <head>
        <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
        <meta http-equiv="Content-Language" content="ja" />
        <meta http-equiv="Content-Script-Type" content="text/javascript" />
        <meta http-equiv="Content-Style-Type" content="text/css" />
        <meta http-equiv="imagetoolbar" content="no" />
        <title>TEST</title>
        <!-- JS -->
        <script type="text/javascript" src="http://ajax.googleapis.com/ajax/libs/jquery/1.3.2/jquery.min.js"></script>
        <script type="text/javascript">
     function getQuerystring(key, default_)
     {
      if (default_==null) default_="";
      key = key.replace(/[\[]/,"\\\[").replace(/[\]]/,"\\\]");
      var regex = new RegExp("[\\?&]"+key+"=([^&#]*)");
      var qs = regex.exec(window.location.href);
      if(qs == null)
       return default_;
      else
       return qs[1];
     }
     $(function(){
      alert(getQuerystring('msg', ''));
     });
        </script>
    </head>
    <body>
   http://localhost/phpbox/getQueryParam.html?msg=hello world!
    </body>
</html>

会社の友たちが書いてた、便利ですので、シェアする