2012年8月21日火曜日

excelの数値format

ラベル: ,
内容 指定文字 例
表示する桁数を指定する。"0"1つで1桁を表し、それより桁数が少ない数値の場合は"0"で埋められる。 0 Format(12345,"0000000") → 0012345

Format(12345,"000") → 12345
表示する桁数を指定する。"#"1つで1桁を表し、それより桁数が少ない数値の場合は元の数値がそのまま返される。 # Format(12345,"#######") → 12345

Format(12345,"###") → 12345
0や"#"と組み合わせて小数点の位置を指定する。 . Format(12345.567,"0000000.00") → 0012345.57

Format(12345.567,"0000000.00000") → 0012345.56700

Format(12345.567,"#######.##") → 12345.57

Format(12345.567,"#.#####") → 12345.567
0や"#"と組み合わせて1000ごとにカンマで区切る。 , Format(12345,"0,000,000") → 0,012,345

Format(12345,"#,###") → 12,345
数値を100倍してパーセント表示する。 % Format(0.25,"#%") → 25%
数値の先頭に￥マークを付ける。 \\ Format(12345,"\\#,###") → \12,345
このマークのすぐ後1文字をそのまま表示する。 \ Format(12345,"\@#,###") → @12,345

Format(12345.56,"0.000\円/\ケ") → 12345.560円/ケ
ダブルクォーテーションで囲まれた文字列はそのまま表示する。

Format(12345,"#,###""です""") → 12,345です
投稿者 kg88 時刻: 23:05 0 コメント

2012年8月17日金曜日

sql、カレンダー作成

ラベル: ,
2010/4/1から2012/5/31までのカレンダーを作成


Declare @date table(d datetime)
Declare @d datetime

set @d='20100401'

While @d<='20120531'
Begin
Insert into @date values (@d)
set @d=@d+1
End
Select d as date_ymd into calendar from @date

投稿者 kg88 時刻: 18:31 0 コメント

エクセルでデータベースを参照するサンプル、SQL ServerとmySQL対応

ラベル: , , ,
シート1の名前を「"テーブル一覧"」にして、ボタンを追加する
そして、I列の1から5行目、下記の情報を入れる
サーバー
DB名
ユーザ
パスワード
接続DBタイプ["SQL Server","MySQL ODBC 5.1 DRIVER"]
※今のところ、MS SQL Serverとmysqlしか対応していない
シート"テーブル一覧"は
Private Sub CommandButton1_Click()
 Call getTables
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    'MsgBox Target.TextToDisplay
    getTableData Target.TextToDisplay
End Sub

モジュールに下記のコード
Public con As ADODB.Connection
Public wb As Workbook
Public st As Worksheet
Public gDB As String
Public gConDriver As String
Dim connectionString As String


Sub initDBcon()


Set wb = ThisWorkbook
Set st = wb.Worksheets("テーブル一覧")
'接続文字列
gConDriver = st.Range("I5")


Select Case gConDriver
    Case "SQL Server"
        connectionString = "Provider=Sqloledb;" _
                & " Data Source=" & st.Range("I1") & ";" _
                & " Initial Catalog=" & st.Range("I2") & ";" _
                & " Connect Timeout=15;" _
                & " user id=" & st.Range("I3") & ";" _
                & " password=" & st.Range("I4")
    Case "MySQL ODBC 5.1 DRIVER"
        connectionString = "Driver={" & gConDriver & "};" _
                & " SERVER=" & st.Range("I1") & ";" _
                & " DATABASE=" & st.Range("I2") & ";" _
                & " USER=" & st.Range("I3") & ";" _
                & " PASSWORD=" & st.Range("I4") & ";"
End Select

gDB = st.Range("I2")

'ADODB.Connection生成
Set con = New ADODB.Connection
On Error GoTo Err

'MySQLに接続
con.Open connectionString
Exit Sub
Err:
    Set con = Nothing
    MsgBox (Err.Description)

End Sub
Sub getTables()

Dim rs As ADODB.Recordset


Dim sqlStr As String

Dim rowNo As Integer
Dim colNo As Integer
Dim item As Variant


Call initDBcon
If con Is Nothing Then
    Exit Sub
End If
Application.DisplayAlerts = False
For Each stname In wb.Sheets
    If stname.Name <> "テーブル一覧" Then
        stname.Delete
    End If
Next
Application.DisplayAlerts = True

'SQL文
Select Case gConDriver
    Case "SQL Server"
        sqlStr = "select table_name from information_schema.tables;"
    Case "MySQL ODBC 5.1 DRIVER"
        sqlStr = "show tables;"
End Select


'SQL文実行
Set rs = con.Execute(sqlStr)

'シートデータクリア
'st.Cells.Clear
st.Columns("A:A").Clear
rowNo = 1
Do While rs.EOF = False
    'データ抽出
    For Each item In rs.Fields
        st.Range("A" & rowNo).Value = item.Value
        st.Range("A" & rowNo).Hyperlinks.Add Anchor:=st.Range("A" & rowNo), _
        Address:="", TextToDisplay:=item.Value
    Next
    rowNo = rowNo + 1
    '次のレコード
    rs.MoveNext
Loop

'クローズ
con.Close
Set rs = Nothing
Set con = Nothing

Exit Sub


End Sub

Sub getTableData(ByVal srtTableName As String)
Dim stname As Variant
Dim qt As QueryTable

Call initDBcon
    For Each stname In wb.Sheets
        If stname.Name = srtTableName Then
            Exit Sub
        End If
    Next
    wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).Name = srtTableName
    
On Error GoTo Err
Select Case gConDriver
Case "MySQL ODBC 5.1 DRIVER"
    With wb.Worksheets(srtTableName).ListObjects.Add(SourceType:=xlSrcExternal, Source:=Array(Array( _
        "ODBC;" & connectionString), Array("E=db35211_CustomerMasterList;DefaultTable=Customers;")), _
        Destination:=wb.Sheets(srtTableName).Range("$A$1")).QueryTable
        .CommandText = Array("Select * FROM " & srtTableName)
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "テーブル_" & gDB & "_" & srtTableName
        .Refresh BackgroundQuery:=False
    End With
Case "SQL Server"
    With wb.Worksheets(srtTableName).ListObjects.Add(SourceType:=xlSrcExternal, Source:=Array( _
        "OLEDB;" & connectionString), Destination:=wb.Sheets(srtTableName).Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("""" & gDB & """.""dbo"".""" & srtTableName & """")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "テーブル_" & gDB & "_" & srtTableName
        .Refresh BackgroundQuery:=False
    End With
End Select
    Exit Sub
    
Err:
    Set con = Nothing
    MsgBox (Err.Description)

End Sub
投稿者 kg88 時刻: 13:25 1 コメント

2012年8月15日水曜日

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

ラベル: 
'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
投稿者 kg88 時刻: 16:04 0 コメント

大量データの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などで文字列を数字に変換する
投稿者 kg88 時刻: 10:17 0 コメント

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のコードで実装したほうが無難
投稿者 kg88 時刻: 9:59 0 コメント

2012年8月2日木曜日

ランダム数字の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
投稿者 kg88 時刻: 14:14 0 コメント
登録: コメント (Atom)