[自宅鯖なので深夜になると見れなくなります。
(´･ω･`)ﾌﾞﾐ=3]
[かなり未定。おおむね19：00以降0：00時前後まで]
更新日 2008/07/23
ちょっ
とかゆいところに手が届くVBA
Excel2002以降やAccess2002以降などで使えるとおもいます。（Office2007では不明）
（Word2002ではVBAそのものを使わないのでわかりませんが、たぶん使えるとおもいます。）
ソースが汚いのはご愛嬌(´･ω･`)ﾌﾞﾐ=3
===============================================================
数字以外の文字を省いてひとつの数字として返します。
文字列の数字に空白やカンマなどが混じってExcelに貼り付けても
そのまま数字として扱えない場合に使います。
ドットはそのままドットとして扱われます。
=str2double(数字に変換したい文字列)
Function str2double(str As String) As Double
Dim temp As String
Dim l As Integer
Dim c0 As Integer
Dim c9 As Integer
c = 46 '46はドットのキャラクターコード
c0 = 48 '48は0のキャラクターコード
c9 = 57 '57は9のキャラクターコード
l = Len(str)
For i = 1 To l
If Asc(Mid(str, i, 1)) = c Or (Asc(Mid(str, i, 1)) >= c0 And Asc(Mid(str, i, 1)) <= c9) Then
temp = temp + Mid(str, i, 1)
End If
Next i
str2double = Val(temp)
End Function
===============================================================
日付から曜日を表示します。
=weekdayj(日付)
Function weekdayj(d_str As String) As String
Dim ans_str As String
Dim f_int As Integer
f_int = Weekday(d_str, 0)
Select Case f_int
Case 1
ans_str = "日曜日"
Case 2
ans_str = "月曜日"
Case 3
ans_str = "火曜日"
Case 4
ans_str = "水曜日"
Case 5
ans_str = "木曜日"
Case 6
ans_str = "金曜日"
Case 7
ans_str = "土曜日"
End Select
weekdayj = ans_str
End Function
===============================================================
文字列を全角半角ひらがなカタカナに変換します。
1から7までの番号によって変換が異なります。
0＝ひらがなをカタカナへ
1＝カタカナをひらがなへ
2＝小文字を大文字へ
3＝大文字を小文字へ
4＝カタカナの小文字を大文字へ
5＝半角文字を全角文字へ
6＝全角文字を半角へ
=h2kconv(番号,文字列)
Function h2kconv(h As Integer, m As String)
Dim c As Integer
Dim sc As Integer
Dim i As Integer
Dim temp As Integer
Dim ans As String
If m = "" Then
h2kconv = ""
GoTo owari
End If
c = h
ans = m
Select Case c
Case 0
Rem ひらがなをカタカナへ
ans = StrConv(ans, vbKatakana)
Case 1
Rem カタカナをひらがなへ
ans = StrConv(ans, vbHiragana)
Case 2
Rem 小文字を大文字へ
ans = StrConv(ans, vbUpperCase)
Case 3
Rem 大文字を小文字へ
ans = StrConv(ans, vbLowerCase)
Case 4
Rem カタカナの小文字を大文字へ
sc = Len(ans)
For i = 1 To sc
temp = Asc(Mid$(ans, i, i))
Select Case temp
Case 167
temp = temp + 10
Case 168
temp = temp + 10
Case 169
temp = temp + 10
Case 170
temp = temp + 10
Case 171
temp = temp + 10
Case 172
temp = temp + 40
Case 173
temp = temp + 40
Case 174
temp = temp + 40
Case 175
temp = temp + 19
Case 176
temp = temp - 131
End Select
Mid$(ans, i, i) = Chr(temp)
temp = 0
Next i
Case 5
Rem 半角文字を全角へ
ans = StrConv(ans, vbWide)
Case 6
Rem 全角文字を半角へ
ans = StrConv(ans, vbNarrow)
Case Else
Rem それ以外の場合
ans = "Can't Convert[" + ans + "]"
End Select
h2kconv = ans
owari:
End Function
===============================================================
手形の金額から印紙税の金額を算出します。
※印紙税の金額変更などがあった場合は、手形金額の条件、印紙税金額
等を変更する必要があります。
=inshi_calc(手形の金額)
Function inshi_calc(i_long) As Long
On Error GoTo error_trap
Dim tk_long As Long, anser As Long
Dim inshi(15) As Long, jk(15) As Long
anser = 0If IsNull(i_long) Then
tk_long = 0
Else
tk_long = i_long
End If'印紙税の金額を格納
inshi(0) = 0
inshi(1) = 200
inshi(2) = 400
inshi(3) = 600
inshi(4) = 1000
inshi(5) = 2000
inshi(6) = 4000
inshi(7) = 6000
inshi(8) = 10000
inshi(9) = 20000
inshi(10) = 40000
inshi(11) = 60000
inshi(12) = 100000
inshi(13) = 150000
inshi(14) = 200000
inshi(15) = 0'条件に使う手形金額を格納
jk(0) = 100000
jk(1) = 1000000
jk(2) = 2000000
jk(3) = 3000000
jk(4) = 5000000
jk(5) = 10000000
jk(6) = 20000000
jk(7) = 30000000
jk(8) = 50000000
jk(9) = 100000000
jk(10) = 200000000
jk(11) = 300000000
jk(12) = 500000000
jk(13) = 1000000000
jk(14) = 0
jk(15) = 0
Select Case tk_long
Case Is < jk(0)
anser = inshi(0)
Case Is <= jk(1)
anser = inshi(1)
Case Is <= jk(2)
anser = inshi(2)
Case Is <= jk(3)
anser = inshi(3)
Case Is <= jk(4)
anser = inshi(4)
Case Is <= jk(5)
anser = inshi(5)
Case Is <= jk(6)
anser = inshi(6)
Case Is <= jk(7)
anser = inshi(7)
Case Is <= jk(8)
anser = inshi(8)
Case Is <= jk(9)
anser = inshi(9)
Case Is <= jk(10)
anser = inshi(10)
Case Is <= jk(11)
anser = inshi(11)
Case Is <= jk(12)
anser = inshi(12)
Case Is <= jk(13)
anser = inshi(13)
Case Is > jk(13)
anser = inshi(14)
Case Else
anser = 999
End Select
inshi_calc = anser
GoTo end_inshi_calc
error_trap:
MsgBox ("エラー発生")
Resume end_inshi_calc
end_inshi_calc:End Function
===============================================================
Excelの所定範囲をCSVとして出力します。
ただし、文字列が””（ダブルクォーテーション）でくくられずにCSV出力すること
を目的としています。
Excelのデータを金融機関向けのデータへ変換するのに利用できるとおもいます。
※このマクロは「魔術幻燈」さんのVBAサンプルマクロを参考に改変したものです。
http://www.bekkoame.ne.jp/~poetlabo/
有用なデータ公開に感謝します。m(_._)m
利用の際は、ボタンにマクロを組み込むなどして利用してください。
Sub select2csv()
Dim file_name As String
Dim FileNum As Integer
Dim rn As Range, us As Range
Dim cn As Integer, cend As Integer
Dim str_cast As String
'ファイルの保存先設定
file_name = "ファイルの保存先"
'範囲指定し、変数へセットする。
'Range(所定の範囲).Select
'範囲が確定しているなら、ここに設定。範囲が決まっていないなら、コメントアウト
Set us = Selection
'ファイルへの保存準備。
FileNum = FreeFile()
Open file_name For Output Access Write As #FileNum
cend = us.Columns.Count - 1
'ファイルへの書き込み
For Each rn In us.Rows
For cn = 1 To cend
str_cast = rn.Columns(cn)
Print
#FileNum, str_cast + ",";
Next cn
str_cast = rn.Columns(cn)
Print #FileNum, str_cast
Next
Close #FileNum
End Sub