カゲンぱぱのイイカゲンメモ帳

2012年9月16日日曜日

vb,vbaの（仮）非同期実行方法？？

ラベル: vba

for i = 0 to 9999
  DoEvents
next

DoEventsはcupビジー時でもユーザのインプットに対してUIを反応させることができるらしい
ここでは詳しく書いています、ありがとうございました。

2012年9月6日木曜日

mysqlのload data infile

ラベル: csv, mysql

一般的にCSVファイルをmysqlコンソルで直接流し込む...



csvの中身はこんな感じ：

10000031,"ああああ",""

10000041,"いいいい",""

10000050,"うううう","おおおお"

10000130,"ささささ","しししし"

文字コードはsjisで、改行コードはCRLF



流しこむコマンド：

mysql> set character_set_database=sjis;

mysql> LOAD DATA INFILE "C:\\Documents and Settings\\username\\data.csv" INTO TABLE my_table FIELDS TERMINATED BY ',' ENCLOSED BY '"' LINES TERMINATED BY '\r\n' STARTING BY '';

LINES TERMINATED追加しないとおかしいことになる。

2012年9月5日水曜日

vba条件書式の罠

ラベル: excel, vba, 罠

現象：vbaで条件書式を追加したら、訳がわからない条件が追加される、Excel2007
下のコードで「C1」セルに、自分自身がエラーの場合、背景色を変える条件書式を追加したところ

Sub test()
    Sheet1.Range("C1").FormatConditions.Delete
    Sheet1.Range("C1").FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(C1)"
    Sheet1.Range("C1").FormatConditions(1).Interior.ColorIndex = 38
End Sub

実行後、出来た数式を見てみると、なんだこりゃ～？！「ISERROR(C1)」と指定したのに、「XFD1」とはなんだ？！！

試しに絶対参照の「ISERROR($C$1)」にしてみたら、治った（当たり前だ）。でも絶対参照だとソートとかしたら大変なことになるので...
まぁ、最後はこうして治ったけど、なんか腑に落ちないな～

Sub test()
    Sheet1.Activate
    Sheet1.Range("C1").Select
    Sheet1.Range("C1").FormatConditions.Delete
    Sheet1.Range("C1").FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(C1)"
    Sheet1.Range("C1").FormatConditions(1).Interior.ColorIndex = 38
End Sub

2012年9月2日日曜日

google spreadsheetsで乱数キーを生成する関数

ラベル: google apps, google spreadsheets

下記のコードをスクリプトエディタで追加して

function randString(cb) {
  var rgch = "abcdefghijklmnopqrstuvwxyz";
  rgch = rgch.toUpperCase() + "0123456789";
  var tmpString = "";
  for (var i = 1; i <= cb; i++) {
    var startPos = Math.ceil((Math.random() * rgch.length));
    tmpString = tmpString + rgch.substring(startPos, startPos + 1);
  }
  return tmpString;
}

function genKey(cn) {
  var keys = [];
  for (var i = 0; i <= cn - 1; i++) {
    keys.push(randString(4));
  }
  return keys.join("-");
}

スプレッドシートで数式を入れると、乱数生成のキーが生成される。

2012年8月21日火曜日

excelの数値format

ラベル: excel, vba

内容	指定文字	例
表示する桁数を指定する。"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です

2012年8月17日金曜日

sql、カレンダー作成

ラベル: mysql, 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

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

ラベル: excel, mysql, sql, vba

シート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