- ベストアンサー
VBのコーディングについて
AKARI0418の回答
- AKARI0418
- ベストアンサー率67% (112/166)
私ならばこんな感じで作ると思います。 SQLを使用することで、拡張性が格段にあがります。 Sub my_test() 'ADODBを利用するために参照設定ActiveX Data Objects 2.8 Libraryを追加してください。 '定数 Const InputFile As String = "C:\INFILE.txt" Const OutCSVDir As String = "C:\" Const OutCSVFileName As String = "OUTCSVFILE.txt" Const OutCSVFile As String = OutCSVDir & OutCSVFileName Const OutFile As String = "C:\OUTFILE.txt" Const Kubuns As String = "区分,商品名,売上" Dim inp_fileNum As Integer Dim out_csvfileNum As Integer Dim inp_data As String Dim kubun As String Dim syohin As String Dim uriage As Integer Dim write_data As String inp_fileNum = FreeFile 'CSVファイルを作成する Open InputFile For Input As #inp_fileNum out_csvfileNum = FreeFile Open OutCSVFile For Output As #out_csvfileNum write_data = Kubuns Print #out_csvfileNum, write_data 'ファイルの終了までループ Do Until EOF(inp_fileNum) Line Input #inp_fileNum, inp_data '読み込んだレコードの各項目を変数に代入 'kubun = Trim(Left(inp_data, 10)) '取り込んだときに、均等な幅にするためにトリミングしない kubun = Left(inp_data, 10) syohin = Trim(Mid(inp_data, 11, 10)) uriage = Right(inp_data, 8) write_data = kubun & "," & syohin & "," & uriage Print #out_csvfileNum, write_data Loop Close #out_csvfileNum Close #inp_fileNum Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim strConnectionString As String Dim strSQL As String Dim out_fileNum As Integer Dim out_data As String Set cn = New ADODB.Connection Set rs = New ADODB.Recordset strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & OutCSVDir & ";" & _ "Extended Properties=""Text;HDR=YES;FMT=Delimited""" strSQL = "SELECT 区分,COUNT(区分), FORMAT(SUM(売上),'00000000') FROM " & OutCSVFileName & " GROUP BY 区分" cn.ConnectionString = strConnectionString cn.Open rs.Open strSQL, cn, adOpenStatic, adLockOptimistic, adCmdText out_fileNum = FreeFile Open OutFile For Output As #out_fileNum rs.MoveFirst While Not rs.EOF 'レコード数分ループ out_data = vbNullString For i = 0 To rs.Fields.Count - 1 out_data = out_data & rs.Fields(i).Value If i <> rs.Fields.Count - 1 Then 'スペース区切り out_data = out_data & " " End If Next i Print #out_fileNum, out_data '次のレコードへ rs.MoveNext DoEvents Wend Close #out_fileNum rs.Close cn.Close Set rs = Nothing Set cn = Nothing End Sub もとデータをCSV形式に展開し、CSVファイルへADODBを使用してアクセスすることで、SQLを実行しています。 しかも早いです。 読み込み件数が多い場合は、自力読み込みよりも早い場合が多いです。 中間ファイルのCSVファイルは邪魔ならばkillしてください。 参照設定を行いたくない場合は、遅延バインディングを行う用に変更してください。
関連するQ&A
- グループごとの集計、全体の集計について
いつもお世話になっております。 ＶＢＡでの課題で行き詰ってしまったので、どなたかお力をお貸しいただけないでしょうか？ コードの効率のよい書き方が分からないため 非常に長くなってしまいますが、すべて書かせていただきます。 課題は Ａ グループ１ 商品１ 300000 Ａ グループ１ 商品２ 460000 Ａ グループ２ 商品１ 120000 Ａ グループ２ 商品２ 80000 Ａ グループ３ 商品３ 71000 Ｂ グループ１ 商品１ 200000 Ｂ グループ１ 商品２ 208000 Ｂ グループ２ 商品１ 2300 となっている表を Ａ グループ１ 商品１ 300000 Ａ グループ１ 商品２ 460000 グループ１ 760000 Ａ グループ２ 商品１ 120000 Ａ グループ２ 商品２ 80000 グループ２ 200000 Ａ グループ３ 商品３ 71000 グループ３ 71000 支店Ａ 1031000 Ｂ グループ１ 商品１ 200000 Ｂ グループ１ 商品２ 208000 グループ１ 408000 Ｂ グループ２ 商品１ 2300 グループ２ 2300 支店Ｂ 410300 合計（Ａ＋Ｂ） 1441300 このように、グループが変わるとグループ合計を出し、 支店名が変わると支店合計を出し、 最終的にすべての合計を出力するコーディングをしています。 今回は配列変数を使わないということなのですが 以下のような流れで考えました '変数の宣言 Dim X As String Dim Y As String Dim siten_A As String '支店名 Dim siten_B As String Dim kubun_A As String '区分 Dim kubun_B As String Dim syohin_A As String '商品名 Dim syohin_B As String Dim kingaku_A As Long '金額 Dim kingaku_B As Long Dim k_goukei As Long '区分合計 Dim s_goukei As Long '支店合計 Dim goukei As Long '合計 'ファイルを開く Open "C:\My Documents\INFILE.txt" For Input As #1 Open "C:\My Documents\OUTFILE.txt" For Output As #2 '１行目を読み込み、変数に格納 Line Input #1, X siten_A = Left(X, 10) kubun_A = Mid(X, 11, 10) kingaku_A = Right(X, 8) syohin_A = Mid(X, 21, 15) Do Until EOF(1) '２行目以降を読み込み変数に格納 Line Input #1, Y siten_B = Left(Y, 10) kubun_B = Mid(Y, 11, 10) kingaku_B = Right(Y, 8) syohin_B = Mid(Y, 21, 15) If siten_A = siten_B And kubun_A = kubun_B Then Print #2, siten_A & kubun_A & syohin_A & kingaku_A k_goukei = kingaku_A + kingaku_B kingaku_A = kingaku_B siten_A = siten_B kubun_A = kubun_B syohin_A = syohin_B ElseIf siten_A = siten_B And kubun_A <> kubun_B Then Print #2, siten_A & kubun_A & syohin_A & kingaku_A s_goukei = s_goukei + k_goukei k_goukei = k_goukei Print #2, k_goukei siten_A = siten_B kubun_A = kubun_B syohin_A = syohin_B kingaku_A = kingaku_B Else Print #2, siten_A & kubun_A & syohin_A & kingaku_A Print #2, k_goukei s_goukei = s_goukei + k_goukei Print #2, s_goukei siten_A = siten_B kubun_A = kubun_B syohin_A = syohin_B kingaku_A = kingaku_B End If Loop Print #2, siten_A & kubun_A & syohin_A & kingaku_A k_goukei = k_goukei + kingaku_A Print #2, k_goukei s_goukei = s_goukei + k_goukei Print #2, s_goukei goukei = goukei + s_goukei Print #2, goukei Close #1 Close #2 End Sub となっています。 これを実行すると、各レコードを出力した後に 合計を出したいのですが 各レコードの金額が、一つ前の金額に足されたものになっており 期待通りの出力ができません。 前半で間違っているため、後半の支店合計や全体の合計も 変わってきてしまい、どこをなおせばよいかわからない状態です。 ＶＢは初心者なので、長くなってもかまわないので 教えていただければと思います。 長くなりましたが、よろしくお願いします。
- ベストアンサー
- Visual Basic
- DLL VBとC++
VBAからVC++2005のDLLを呼び出すプログラムを書いています。 VB側で作成したcpp_proc関数を呼ぶとVBアプリ自体が落ちました。 DLLのreturnの直前に以下のMessageBoxで表示させるとそこまでは表示され、 リターンを押すと、落ちました。 VB側の引数の値 String * 8192が悪いのでしょうか？ return直前まで動作していたので、DLLの戻り値に何か原因があるのでしょうか？ ついでの質問ですが、DEFの @1は無くても動くのでしょうか？ 意味が知りたいです。 // ----- C++ (DLL側) ----- int __stdcall cpp_proc(LPCSTR inp, LPSTR out) { ... 省略 MessageBox(0, "ここまで通過", "debug", MB_OK); return 0; } // ----- DEF ----- LIBRARY "example" DESCRIPTION 'テスト' EXPORTS ; 明示的なエクスポートはここへ記述できます cpp_proc @1 '----- VB側 ----- Public Declare Function cpp_proc Lib "example.dll" _ (ByVal inp As String, ByRef out As String) As Integer Public Sub Test() Dim ret As Integer Dim inp As String Dim out As String * 8192 ret = cpp_proc(inp, out) MsgBox("ret=[" & Cstr(ret) & "]"); End Sub
- ベストアンサー
- C・C++・C#
- VBA どこでもセル選択
教えて頂いたＶＢＡなのですがもう一つ Sub Macro1() Dim Ws01 As Worksheet Dim Counter As Long, i As Long, j As Long Dim INP As String Set wS = Worksheets("Sheet4") wS.Cells.ClearContents For i = 3 To ActiveSheet.UsedRange.Rows.Count INP = "" For j = Selection(1).Column To Selection(Selection.Count).Column If Cells(i, j) = 1 Then INP = INP & Cells(2, j) & "," End If Next j Counter = Counter + 1 If INP <> "" Then wS.Cells(Counter, "A") = Left(INP, Len(INP) - 1) End If Next i End Sub -------------------------------------------------------------- For i = 3 のところを3としないでどのセル（行）にも対応させたいのですが どうすればいいでしょうか？
- ベストアンサー
- Excel（エクセル）
- VBからOracle接続が出来ません。
こんにちは。 VisualBasic6.0EnterprizeEdition から Oracle8i の接続を試みております。 接続が出来ません。コードは本のものをそのまま書いたので、間違いはないと思います。 Private Function OraOPN() As Boolean Dim strDB As String * 30 'サービス名 Dim strUID As String * 30 'ユーザー名 Dim strPWD As String * 30 'パスワード Dim strUP As String Dim strMSG As String 'エラー時のメッセージ On Error GoTo Ora_Error strDB = Trim(txtLogon(2).Text) strUID = Trim(txtLogon(0).Text) strPWD = Trim(txtLogon(1).Text) strUP = strUID & "/" & strPWD strMSG = "データベースへの接続ができません" Set OraSession = CreateObject("OracleInProcServer.XOraSession") Set OraDatabase = OraSession.OpenDatabase(strDB, strUP, &H1&) OraOPN = True Exit Function Ora_Error: OraOPN = False Call MsgBox(strMSG & vbCrLf & " システム管理者に連絡してください" & vbCrLf & vbCrLf & "", vbCritical) End End Function 以上のコードで、接続できません。本に書いてあるとおりそのままのコードです。オラクルサーバとVBプログラムは同一マシン上に置いてあります。 私は、Java専門でVBはわかりません。誰かわかる方がいたら、教えてください。よろしくお願いします。
- ベストアンサー
- Visual Basic
- VBを2008を用いてCSVを取り込む ””で区切られていない数値混入
VBを2008を用いてCSVを取り込む ””で区切られていない数値混入 文字列に，が含まれている場合がある。 題名どおりなのですが、以下のようなCSVファイルをVB2008で取り込もうと考えています。 "AAAAA",BBBBB,CCCCC,"DDDD,DDD","EEEEE","FFFFF" （同じアルファベットが本来同じ項目のデータ、BとCは0-9の数字のみ入ります またBCには常に””が含まれません。 Dは文字列なのですが、まれに「，」が含まれます） 下のものが現在使用しているソースですがsplitで「,」を指定しているので 当然Dが２つのデータとして認識されています。 BやCが””で囲まれていれば「”,”」で区切ればすむのですが一部が””なしなので どうやろうか迷っています。 実現したいこととしては ""なしの時は必ず、コンマまでが１つのデータ、 ""があれば""で区切られたデータが１つのデータとできればいいんですが。。。 以下ソースです。 ちなみにASPXファイルです。 （replaceDoubleQuotesというのは”を削除するための関数で無視していただいて結構です。 また以下のソースでは取り込み自体はせずにタイトル行がはいっているCSVファイルを弾く作業をしているのですが CSVからデータを取り出す作業は同じなので短いソースを使用させてもらっています） Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Dim Reader2 As New IO.StreamReader("C:\UploadedFiles\Uriage.txt", System.Text.Encoding.GetEncoding("Shift-JIS")) Dim Items2() As String 'CSVの各項目を表す配列 Dim Line2 As String = Reader2.ReadLine 'CSVの一行 Items2 = Line2.Split(",") Dim num_hantei As String = "^[0-9]+$" If Not (Regex.IsMatch(replaceDoubleQuotes(Items2(3)), num_hantei)) Then Dim objFSO As Object objFSO = CreateObject("Scripting.FileSystemObject") objFSO.DeleteFile("C:\UploadedFiles\Uriage.txt", True) objFSO = Nothing Label1.Text = "取り込みエラー。タイトル行がはいっている可能性があります。" Exit Sub End If Reader2.Close() End Sub Function replaceDoubleQuotes(ByVal apdata As Object) As String '文字列に変換する Dim tmp As String = String.Format("{0}", apdata) '1つのダブルクォーテーションを0個に置換する つまり消去する replaceDoubleQuotes = tmp.Replace("""", "") End Function
- ベストアンサー
- Visual Basic
- VBで文書を検索するシステムを作ったのですが、検索実行のたびに表示されるレコードが増えます。
VBで文書検索を行うシステムを作っているのですが、文字列を変えて検索するたびにMSHFlexGrid上に表示されるレコードが増えていきます。原因がわかりません。よろしくお願いします。 Private Sub Command1_Click() Dim kubun As String '文字列型 Dim mojiretsu_k As String '文字列型 Dim A As Integer ' Dim cn As New ADODB.Connection 'データベースに接続するためのコネクションオブジェクト Dim cmd As ADODB.Command Dim rst As ADODB.Recordset Dim strSQL As String Dim i As Integer If Option7 = True Then ElseIf Option8 = True Then kubun = "a" ElseIf Option9 = True Then kubun = "b" ElseIf Option10 = True Then kubun = "c" ElseIf Option11 = True Then kubun = "d" ElseIf Option12 = True Then kubun = "e" ElseIf Option13 = True Then kubun = "f" ElseIf Option14 = True Then kubun = "g" ElseIf Option15 = True Then kubun = "h" ElseIf Option16 = True Then kubun = "i" ElseIf Option17 = True Then kubun = "j" End If Set cn = New ADODB.Connection cn.ConnectionString = _ "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Persist Security Info=False;" & _ "Data Source=aaa.mdb;" & _ "Mode=Read" cn.Open Set rst = New ADODB.Recordset ' レコードソースにSQL文を指定 mojiretsu_k = Text1.Text If Option18.Value = True Then '現行文書のみ検索 If Option7.Value = True Then strSQL = "Select 資料区分,資料名称,ファイルパス From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 廃止フラグ = False order by ID" Else strSQL = "Select 資料区分,資料名称,ファイルパス From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 資料区分 = """ & kubun & """ and 廃止フラグ = False order by ID" End If ElseIf Option19.Value = True Then '廃止文書のみ検索 If Option7.Value = True Then strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 廃止フラグ = true order by ID" Else strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 資料区分 = """ & kubun & """ and 廃止フラグ = true order by ID" End If ElseIf Option20.Value = True Then '現行＋廃止文書を検索 If Option7.Value = True Then strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' order by ID" Else strSQL = "Select 資料区分,資料名称,ファイルパス,廃止フラグ From T_SHIRYO WHERE 資料名称 like'%" & mojiretsu_k & "%' and 資料区分 = """ & kubun & """ order by ID" End If End If rst.Open strSQL, cn, adOpenStatic, adLockOptimistic, adCmdText i = 0 Do While Not rst.EOF With Form1.MSHFlexGrid1 .AddItem "" .TextMatrix(i, 0) = rst.Fields("資料区分") .TextMatrix(i, 1) = rst.Fields("資料名称") .TextMatrix(i, 2) = rst.Fields("ファイルパス") End With i = i + 1 rst.MoveNext Loop rst.Close cn.Close Set rst = Nothing Set cn = Nothing End Sub
- ベストアンサー
- Visual Basic
- ファイルを読み込んだらVBがフリーズする
↓のコードだと、ファイルを読み込んだ時点でVBがフリーズします（平気なファイルも一部ある）。原因と解決法を教えてください。 Private Sub Command1_Click() CommonDialog1.Filter = "テキスト(*.txt)|*.txt|すべて(*.*)|*.*" CommonDialog1.FilterIndex = 1 CommonDialog1.Flags = cdlONFileMustExist CommonDialog1.CancelError = True On Error Resume Next CommonDialog1.ShowOpen If (Err = 0) Then FileRead CommonDialog1.FileName End If On Error GoTo 0 End Sub Private Sub FileRead(FL As String) Dim FileNo As Integer Dim strDAT As String Dim strELM As String Dim pot1 As Integer, pot2 As Integer Dim pDB1 As Integer, pDB2 As Integer FileNo = FreeFile() Open FL For Input As #FileNo While Not EOF(FileNo) Line Input #FileNo, strDAT strDAT = strDAT & ":" pot1 = InStr(strDAT, ":") While pot1 > 0 strELM = Left(strDAT, pot1) pot2 = InStr(strELM, "OPEN") While pot2 > 0 pDB1 = InStr(strELM, Chr(&H22)) If pDB1 > 0 Then '前の『"』の位置 pDB2 = InStr(pDB1 + 1, strELM, Chr(&H22)) If pDB2 > 0 Then RichTextBox1.Text = RichTextBox1.Text & _ Mid(strELM, pDB1 + 1, pDB2 - pDB1 - 1) & vbCrLf End If End If pot2 = InStr(pDB2 + 1, strELM, "OPEN") Wend strDAT = Mid(strDAT, pot1 + 1) pot1 = InStr(strDAT, ":") Wend Wend Close #FileNo End Sub
- ベストアンサー
- Visual Basic
- VB６のTYPE文をVB.NETのStructureに変えるとき
VB６のTYPE文をVB.NETのStructureに変えるとき 下記VB6のコードをVB.NETのStructureに変える場合 Type kouzou1 i As Integer j As Integer a As String * 20 b As String * 50 End Type を下記にしてみたのですが *20,*50のところは、どのように表現するのでしょうか。 Structure kouzou1 Dim i As Integer Dim j As Integer Dim a As String * 20 <- ステートメントの終わりを示してくださいのエラーになる。 Dim b As String * 50 <- ステートメントの終わりを示してくださいのエラーになる。 End Structure お教え下さい。
- ベストアンサー
- Visual Basic
- VBA 空白表示させたい
教えて頂いたＶＢＡなのですが Sub Macro1() Dim Ws01 As Worksheet Dim Counter As Long, i As Long, j As Long Dim INP As String Set wS = Worksheets("Sheet4") wS.Cells.ClearContents If Selection(Selection.Count).Row <> 2 Then Exit Sub Counter = 0 For i = 3 To ActiveSheet.UsedRange.Rows.Count INP = "" For j = Selection(1).Column To Selection(Selection.Count).Column If Cells(i, j) = 1 Then INP = INP & Cells(2, j) & "," End If Next j If INP <> "" Then Counter = Counter + 1 wS.Cells(Counter, "A") = Left(INP, Len(INP) - 1) End If Next i End Sub ---------------------------------------------------------------------- ｇ ｈ ｉ ｊ パセリ クレソン メキャベツの葉 ごぼう １ １ １ １ １ 1行目 パセリ,クレソン,メキャベツの葉 2行目 3行目 パセリ,メキャベツの葉 と、2行目は詰めずに空白表示したいです。 どこをどうすればできますか？
- ベストアンサー
- Excel（エクセル）
- vb6 バイトオーダエンディアン変換の高速化
お世話になります。 VB6にて下記ソースの様にバイトオーダのエンディアン変換を行っているのですが、 一旦Stringに入れ込んでいるせいなのか、 非常に処理が遅く困っております。 ２Btyteのデータの入れ替えだけなのですが、 高速化もしくは単純化する方法がございましたら教えていただけないでしょうか Public Function Swap(ByVal L As Long) As Integer Dim S As String S = Right(String(4, "0") & Hex(L), 4) Swap = CInt("&H" & Right(S, 2) & Left(S, 2)) End Function
- ベストアンサー
- Visual Basic
お礼
SQLを使うとできるんですね。。 まだ、初心者の私にはちょっとレベルが高すぎるので、 もう少しＶＢを学んでからもう一度チャレンジしてみたいと思います。 何度も回答していただき、本当にありがとうございました。