VBのコーディングについて

このQ&Aのポイント
  • VBの課題で行き詰ってしまったので、力を貸していただければと思います。
  • 商品一覧からレコードを取得し、商品区分で集計し、商品区分・商品件数・売上合計金額を区分別売上表に出力する
  • コーディングですと、欲しいデータが返ってこないので、どなたかご教授いただけないでしょうか?
回答を見る
  • ベストアンサー

VBのコーディングについて

はじめまして。VBの課題で行き詰ってしまったので、力を貸していただければと思います。 課題は【商品一覧からレコードを取得し、取得したレコードを商品区分で集計し、商品区分・商品件数・売上合計金額を区分別売上表に出力する】 といったものです。 商品一覧には、【商品区分・商品名・売上】の順にデータが入っています。 自分なりに考えた手順は Private Sub コマンド1_Click() Dim INP_DATA As String Dim kubun_01 As String Dim syohin_01 As String Dim uriage_01 As Integer Dim kubun_02 As String Dim syohin_02 As String Dim uriage_02 As Integer  Open "C:INFILE.txt" For Input As #1 Open "C:OUT_FILE.txt" For Output As #2 'ファイルの終了までループ Do Until EOF(1) Line Input #1, INP_DATA '読み込んだレコードの各項目を変数に代入 kubun_01 = Trim(Left(INP_DATA, 10)) syohin_01 = Trim(Mid(INP_DATA, 11, 10)) uriage_01 = Right(INP_DATA, 8) '一行目かどうか If Trim(Mid(INP_DATA, 11, 10)) = syohin_01 kubun_01 = Trim(Left(INP_DATA, 10)) syohin_01 = Trim(Mid(INP_DATA, 11, 15)) uriage_01 = Right(INP_DATA, 8) ElseIf Trim(Mid(INP_DATA, 11, 10)) <> syohin_01 Then kubun_02 = Trim(Left(INP_DATA, 10)) syohin_02 = Trim(Mid(INP_DATA, 11, 10)) uriage_02 = Right(INP_DATA, 8) End If If kubun = kubun_hikaku_2 Then goukei = uriage_hikaku_2 + uriage ElseIf kubun <> kubun_hikaku_2 Then Print #2, kubun; syohin; goukei End If Loop '新たに比較用の変数に格納 Do Until EOF(1) Line Input #1, INP_DATA kubun_01 = Trim(Left(INP_DATA, 10)) syohin_01 = Trim(Mid(INP_DATA, 11, 10)) uriage_01 = Right(INP_DATA, 8) Loop Debug.Print "PROGRAM END" Close #1 Close #2 End Sub となっています。長くなってしまい申し訳ありません。 上記のコーディングですと、欲しいデータが返ってこないので、 どなたかご教授いただけないでしょうか?? よろしくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.3

はじめまして 集計等は、先に配列変数を作って、入れておき、後で計算するのがやりやすいかと・・・ 僕なりに書いてみました。ご参考になればと・・・ Private Sub コマンド1_Click() Dim INP_DATA As String Open "C:\INFILE.txt" For Input As #1 Open "C:\OUT_FILE.txt" For Output As #2 'いる分だけ配列変数を作る方法もあるが、とりあえず、多めに変数を作る Dim kubun(10) As String Dim syohin(10) As String Dim uriage(10) As Integer 'ループ用変数 Dim i As Integer Dim a As Integer '初期値セット i = 1 a = 0 Dim kubun_01 As String Dim syohin_01 As Integer Dim uriage_01 As Integer Dim kubun_02 As String Dim syohin_02 As Integer Dim uriage_02 As Integer 'ファイルの終了までループ Do Until EOF(1) Line Input #1, INP_DATA '読み込んだレコードの各項目を変数に代入 kubun(i) = Trim(Left(INP_DATA, 10)) syohin(i) = Trim(Mid(INP_DATA, 11, 10)) uriage(i) = Right(INP_DATA, 8) 配列変数確認用 Debug.Print kubun(i) Debug.Print syohin(i) Debug.Print uriage(i) '配列番号用 i = i + 1 Loop '何個、配列変数が出来たか、保存する a = i '一行目を変数にセット kubun_01 = kubun(1) syohin_01 = 1 uriage_01 = uriage(1) '2行目からは、ループしながら集計 For i = 2 To a - 1 If kubun_01 = kubun(i) Then syohin_01 = syohin_01 + 1 uriage_01 = uriage_01 + uriage(i) Else kubun_02 = kubun(i) syohin_02 = syohin_02 + 1 uriage_02 = uriage_02 + uriage(i) End If Next '変数確認用 Debug.Print kubun_01 Debug.Print syohin_01 Debug.Print uriage_01 Debug.Print kubun_02 Debug.Print syohin_02 Debug.Print uriage_02 '後は OUT_FILE.txt に、↑の変数を書き出せばいいのでは Debug.Print "PROGRAM END" Close #1 Close #2 End Sub 今は kubun が、2種類しか集計していませんが、IF等の分岐でそれぞれ集計を追加して下さい。 不備があったら、すいません。

tao0417
質問者

お礼

丁寧な解説とともにお答えいただきありがとうございます。 上記のコードを入力し、 >'一行目を変数にセット >kubun_01 = kubun(1) >syohin_01 = 1 >uriage_01 = uriage(1) とありますが、syohin_01をsyohin(1)としないのはなぜでしょうか? また、 Print #2, kubun_01; syohin_01; uriage_01 Print #2, kubun_02; syohin_02; uriage_02 を足して出力してみたのですが、結果が、 飲料2 950 調理器具 8 18050 と、飲料以下のグループが最後のグループである 調理器具に足されてしまいました。 この場合どのようにすれば、各項目ごとの件数と売上合計が得られるでしょうか? ifの分岐で、3つ以上の分岐はできるのでしょうか? お礼のはずが質問ばかりになってしまい申しわけありません。

その他の回答 (4)

  • AKARI0418
  • ベストアンサー率67% (112/166)
回答No.5

私ならばこんな感じで作ると思います。 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してください。 参照設定を行いたくない場合は、遅延バインディングを行う用に変更してください。

tao0417
質問者

お礼

SQLを使うとできるんですね。。 まだ、初心者の私にはちょっとレベルが高すぎるので、 もう少しVBを学んでからもう一度チャレンジしてみたいと思います。 何度も回答していただき、本当にありがとうございました。

回答No.4

>syohin_01をsyohin(1)としないのはなぜでしょうか? 集計結果は、区分別の商品数と合計金額が欲しいんですよね。 syohin(1)には、オレンジジュースなどの名前が入っていて、商品数とは関係ないので、使ってません。 syohin_01には、同じ区分がきたら + 1 しているだけです。 >と、飲料以下のグループが最後のグループである >調理器具に足されてしまいました。 >この場合どのようにすれば、各項目ごとの件数と売上合計が得られるでしょうか? 区分名(飲料や調理器具)は、何種類ありますか?

tao0417
質問者

補足

>syohin_01をsyohin(1)としないのはなぜでしょうか? ↑わかりました。ありがとうございます。 区分は4つ作りましたが、何個あるかわからない前提で、 何個区分があったとしても対応できるコーディングにしたいと 考えています。 ↑というのは可能でしょうか??

  • y_yyy
  • ベストアンサー率12% (1/8)
回答No.2

OUT_FILEに書き出しているコードはどこにあるのでしょうか。。。

tao0417
質問者

補足

そうですね、書き出しのコードを書いていませんでした。 また、長くなってしまって申し訳ありませんが、 あらためて作ってみたのが Private Sub コマンド1_Click() Dim INP_DATA As String Dim OUT_STRING As String Dim kubun_01 As String Dim syohin_01 As String Dim uriage_01 As Integer Dim kubun_02 As String Dim syohin_02 As String Dim uriage_02 As Integer Dim goukei As String 'ファイルを開く Open "C:INFILE.txt" For Input As #1 Open "C:OUTFILE.txt" For Output As #2 Do Until EOF(1) Line Input #1, INP_DATA '読み込んだレコードの各項目を変数に代入 kubun_01 = Trim(Left(INP_DATA, 10)) syohin_01 = Trim(Mid(INP_DATA, 11, 10)) uriage_01 = Right(INP_DATA, 8) 'さらに次の行を抽出し、比較する Line Input #1, OUT_STRING kubun_02 = Trim(Left(OUT_STRING, 10)) syohin_02 = Trim(Mid(OUT_STRING, 11, 10)) uriage_02 = Trim(Right(OUT_STRING, 8)) If kubun_01 = kubun_02 Then goukei = uriage_01 + uriage_02 Print #2, kubun_01; goukei End If '新たに比較用の変数に格納 kubun_01 = Trim(Left(INP_DATA, 10)) syohin_01 = Trim(Mid(INP_DATA, 11, 15)) uriage_01 = Right(INP_DATA, 8) Loop Debug.Print "PROGRAM END" Close #1 Close #2 End Sub と、打ち込んでみました。 INP_FILEには 飲料        オレンジジュース  00000300 飲料        紅茶        00000650 調味料       ケチャップ     00001200 調味料       マヨネーズ     00000900 調味料       しょうゆ      00001500 調味料       オリーブオイル   00002300 となっていて、 飲料  2  00000950 調味料 4  00005900 となってほしいのですが、実際には OUT_FILEには 飲料950 調味料2100 調味料3800 食品2450 調理器具9700 となってしまいました。 ・件数の出し方 ・重複しているグループのまとめかた(調味料が分かれてしまっているので) を教えていただけたらと思います。 よろしくお願いいたします。

  • y_yyy
  • ベストアンサー率12% (1/8)
回答No.1

ある程度デバッグはされましたでしょうか。 どういった意味で、「欲しいデータが返ってこない」のかが、 文章から読み取れません。 欲しいデータは、まずどのようなものか、例があるとわかりよいです。 また、上記のコードを実行した結果、どうなるから、予想と違うのかが あるとさらにわかりよいです。 実行時エラーがでてるのかどうか。 たとえば、INP_DATAにはどんな値で取得できていて、それが予想とどう違うのか。etcetc...

tao0417
質問者

補足

ご指摘ありがとうございます。 INP_DATAには 飲料        オレンジジュース  00000300 飲料        紅茶        00000650 調味料       ケチャップ     00001200 調味料       マヨネーズ     00000900 調味料       しょうゆ      00001500  :          :         : のようなデータが入っています。 最終的には 飲料      2      00000950 調味料     3      00003600  :      :       :    というような答えがOUT_FILEに表示されて欲しいのですが 上記のコーディングだと何も表示されないのです。     

関連するQ&A

  • グループごとの集計、全体の集計について

    いつもお世話になっております。 VBAでの課題で行き詰ってしまったので、どなたかお力をお貸しいただけないでしょうか? コードの効率のよい書き方が分からないため 非常に長くなってしまいますが、すべて書かせていただきます。 課題は A グループ1 商品1    300000 A グループ1 商品2    460000 A グループ2 商品1    120000 A グループ2 商品2     80000 A グループ3 商品3     71000 B グループ1 商品1    200000 B グループ1 商品2    208000 B グループ2 商品1     2300 となっている表を A グループ1 商品1    300000 A グループ1 商品2    460000   グループ1        760000 A グループ2 商品1    120000 A グループ2 商品2     80000   グループ2        200000 A グループ3 商品3     71000   グループ3         71000 支店A            1031000 B グループ1 商品1    200000 B グループ1 商品2    208000   グループ1        408000   B グループ2 商品1     2300   グループ2         2300 支店B            410300 合計(A+B)        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 '1行目を読み込み、変数に格納 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) '2行目以降を読み込み変数に格納 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 となっています。 これを実行すると、各レコードを出力した後に 合計を出したいのですが 各レコードの金額が、一つ前の金額に足されたものになっており 期待通りの出力ができません。 前半で間違っているため、後半の支店合計や全体の合計も 変わってきてしまい、どこをなおせばよいかわからない状態です。 VBは初心者なので、長くなってもかまわないので 教えていただければと思います。 長くなりましたが、よろしくお願いします。

  • 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

  • VBA どこでもセル選択

    教えて頂いた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としないでどのセル(行)にも対応させたいのですが どうすればいいでしょうか?

  • 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はわかりません。誰かわかる方がいたら、教えてください。よろしくお願いします。

  • VBを2008を用いてCSVを取り込む ””で区切られていない数値混入

    VBを2008を用いてCSVを取り込む ””で区切られていない数値混入 文字列に,が含まれている場合がある。 題名どおりなのですが、以下のようなCSVファイルをVB2008で取り込もうと考えています。 "AAAAA",BBBBB,CCCCC,"DDDD,DDD","EEEEE","FFFFF" (同じアルファベットが本来同じ項目のデータ、BとCは0-9の数字のみ入ります またBCには常に””が含まれません。 Dは文字列なのですが、まれに「,」が含まれます) 下のものが現在使用しているソースですがsplitで「,」を指定しているので 当然Dが2つのデータとして認識されています。 BやCが””で囲まれていれば「”,”」で区切ればすむのですが一部が””なしなので どうやろうか迷っています。 実現したいこととしては ""なしの時は必ず、コンマまでが1つのデータ、 ""があれば""で区切られたデータが1つのデータとできればいいんですが。。。 以下ソースです。 ちなみに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

  • 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

  • ファイルを読み込んだら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

  • VB6のTYPE文をVB.NETのStructureに変えるとき

    VB6の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 お教え下さい。

  • VBA 空白表示させたい

    教えて頂いた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 ---------------------------------------------------------------------- g      h       i      j パセリ クレソン メキャベツの葉 ごぼう 1      1             1 1                    1 1行目 パセリ,クレソン,メキャベツの葉 2行目  3行目 パセリ,メキャベツの葉 と、2行目は詰めずに空白表示したいです。 どこをどうすればできますか?

  • vb6 バイトオーダエンディアン変換の高速化

    お世話になります。 VB6にて下記ソースの様にバイトオーダのエンディアン変換を行っているのですが、 一旦Stringに入れ込んでいるせいなのか、 非常に処理が遅く困っております。 2Btyteのデータの入れ替えだけなのですが、 高速化もしくは単純化する方法がございましたら教えていただけないでしょうか 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

専門家に質問してみよう