• 締切済み

データを一覧で表示する方法

VB6.0ProfessionalEditionで、 Accessのデータを一覧表示するのを作っているんですが、どうも上手くいかないんです。 OLE_ListというExcelのシートに表示させたいんでFormLoad時に書いていってるんですが、どこがマズおんでしょう？ Dim OLE_List(5, 10) As String Dim rs_cnt As Integer Dim i As Integer （DAOでコネクトして、変数rsでレコードセットしてます） rs_cnt = rs.RecordCount If rs_cnt > 0 Then i = 0 For i = 0 To rs_cnt - 1 str_co = rs("通販会社") str_name = rs("商品名") str_price = rs("価格") str_orderday = rs("注文日") str_slip = rs("伝票No.") OLE_List(1, i) = str_co OLE_List(2, i) = str_name OLE_List(3, i) = str_price OLE_List(4, i) = str_orderday OLE_List(5, i) = str_slip Next End If

みんなの回答

回答No.1

１レコード表示した後で、次のレコードに移動していないので 先頭レコードの値が繰り返し表示されるでしょう。 Nextの前に　rs.Next （rs.MoveNextだったかも）を入れると良いでしょう。

Kalen_F
質問者

補足

あれから、MoveNextが抜けてるのに気づき、試したんですけど、何も表示されないんです。。。。 確かにレコードカウントは５件取れてるんです。 表示のさせ方の記述が問題だと思うんですが、どう思われますか？ もし参考になるようなURLご存知でしたら、教えて下さい。。。。。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • リストボックスのAdditemの文字列生成

    リストボックスのAdditemで表示する内容を一覧にしたいと思い、文字列を生成してみたのですが、どうもきれいに揃いません。どうしてーーー？？？ Do Until rs.EOF (ここで一旦各変数を初期化します） str_co = rs("会社名") str_name = StrConv(rs("商品名"), vbWide) str_price = rs("価格") str_orderday = rs("注文日") str_slip = rs("伝票No.") If Len(rs("受取日")) > 0 Then str_catchday = rs("受取日") Else str_catchday = "" End If If Len(rs("入金日")) > 0 Then str_payday = rs("入金日") Else str_payday = "" End If If rs("返品フラグ") = 1 Then str_returnday = "無" Else str_returnday = "有" End If spc1 = String(7 - Len(str_co), " ") spc2 = String(50 - Len(str_name), " ") spc3 = String(12 - Len(str_price), " ") spc4 = String(15 - Len(str_orderday), " ") spc5 = String(20 - Len(str_slip), " ") spc6 = String(15 - Len(str_catchday), " ") spc7 = String(15 - Len(str_payday), " ") str_data = str_co & spc1 & str_price & spc3 & str_orderday & spc4 & _ str_slip & spc5 & str_catchday & spc6 & str_payday & spc7 & str_returnday .AddItem str_data

  • 制御方法について

    所属名毎にシートを作成し都道府県と所属名が一致したら集計させループさせたいのですがうまくいきません。 データには列135に所属名があり139に都道府県が入っています。 解約シートには6行目5列目から都道府県名が入っています。 最終が沖縄となるので沖縄が入れば抜けるようになっています。 今の状態で実行すると所属名の数毎、都道府県の件数を更にを集計してしまいます。 一度シートを作成した所属はFor～Nextを読み込まないようにしたいのですが 自分なりに制御させようと試みましたが上手く集計されません。 何かアドバイス等ありましたらお願いします。 Dim ingcnt As Integer Dim intHjn As Integer Dim strhjn As String Dim Areastrhjn As String Dim list_cnt As Integer Dim Arealist_cnt As Integer Dim (2) As Worksheet Dim Area_cnt As Integer With Worksheets("解約データ") Set (2) = Sheets("解約・所属別") list_cnt = 2 strhjn = "" Area_cnt = 5 '所属CD1毎のシート作成 Do While Trim$(.Cells(list_cnt, 1)) <> "" '(A列)が空白でない限り繰り返す If strhjn <> .Cells(list_cnt, 135) Then strhjn = .Cells(list_cnt, 135) Sheets("解約").Select Sheets("解約").Copy Before:=Sheets("解約") Sheets("解約(2)").Name = strhjn ActiveSheet.Cells(1, 15) = strhjn End If For Area_cnt = 5 To (2).Cells(6, (2).Columns.Count).End(xlToLeft).Column Area = (2).Cells(6, Area_cnt) Arealist_cnt = 2 Areastrhjn = "" Do While Trim$(.Cells(Arealist_cnt, 1)) <> "" '(A列)が空白でない限り繰り返す Areastrhjn = .Cells(Arealist_cnt, 135) 'エリア集計 If Areastrhjn = .Cells(Arealist_cnt, 135) And _ .Cells(Arealist_cnt, 139) = Area Then ActiveSheet.Cells(7, Area_cnt) = ActiveSheet.Cells(7, Area_cnt) + 1 End If Arealist_cnt = Arealist_cnt + 1 Loop If Area = "沖縄" Then Exit For Next list_cnt = list_cnt + 1 Loop End With End Sub

  • ACCESSでステータスバーにインジケータを表示する方法

    ★T_1　・・・ビル名,電話番号 T_1テーブルに登録されてあるすべてのレコードにアクセス し、その間、インジケータを表示させたいと思っています。・・・が上手くいきませんTT 手順があっているかご指導宜しくお願いいたします。 (1)フォームを作成して非連結のテキストボックスを2つ作りました。(テキストボックス名→ビル名,電話番号にしました)さらにコマンドボタン(調査)を一つ作りました。 (2)コマンドボタンに以下のVBAを記述しました。 Private Sub 調査_Click() Dim cn As ADODB.Connection Dim rs As New ADODB.Recordset Dim cnt As Integer Dim i As Integer Dim j As Long Set cn = CurrentProject.Connection rs.Open "Ｔ_1", cn, adOpenStatic,LockOptimistic cnt = rs.RecordCount SysCmd acSysCmdInitMeter, "処理中です・・・", cnt For i = 0 To cnt - 1 Me.ビル名 = rs.ビル名 Me.電話番号 = rs.電話番号 Me.Repaint SysCmd acSysCmdUpdateMeter, i rs.MoveNext For j = 0 To 1000000 Next j Next i SysCmd acSysCmdRemoveMeter rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub 以上のように記述しコマンドボタンを押すと「メソッドまたはデータメンバが見つかりません」とエラーメッセージがでます。これはどういうことなのでしょうか？宜しくお願いいたします。

  • VB2005で、Structureの配列を返すプログラムを以下のように書きたい

    VB2005で、Structureの配列を返すプログラムを以下のように書きたいのですが、そもそもVB6しか使ったことが無いもので、以下のような素数の結果を返すこのプログラムの書き方はVB2005らしいでしょうか？ Module Module1 Public Structure SosuuStatus Public num As Integer Public status As String End Structure Class Sosuu Function SosuuCheck(ByVal st As Integer, ByVal ed As Integer) As SosuuStatus() Dim i As Integer, j As Integer Dim sosuu(0 To ed - st) As SosuuStatus Dim cnt As Integer = 0 For i = st To ed sosuu(cnt).num = i sosuu(cnt).status = "" '初期化 If 1 = i Then sosuu(cnt).status = "素数ではない" ElseIf 0 = (i Mod 2) Then sosuu(cnt).status = "素数ではない" Else For j = 3 To Math.Sqrt(ed) If 0 = (i / j) Then sosuu(cnt).status = "素数ではない" End If Next j End If If sosuu(cnt).status = "" Then sosuu(cnt).status = "素数である" End If cnt = cnt + 1 Next i SosuuCheck = sosuu End Function End Class End Module

  • テキストボックス空欄への追加入力

    リストボックス１であ行の氏名項目を選択実行しテキストボックス１～８に入力された後にか行にリストボックス項目を変え氏名を選択実行した場合、下記のコードではテキストボックス１からまた上書きされる。テキストボックス空欄に続けて選択項目が入力される方法はあるのでしょうか。悩んでいます。どなたかコードがわかる方よろしくお願いします。 Private Sub 実行Cnd_Click() Dim cnt As Integer 　　Dim i As Integer If ListBox1.ListIndex = -1 Then Exit Sub cnt = 1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then Me.Controls("TextBox" & cnt).Text = ListBox1.List(i) cnt = cnt + 1 End If Next End Sub

  • 配列にて格納したデータの出力

    txtファイルで取り込んだ2行にまたがっている数値・英文字・ひらがななどを1行ずつ配列として格納した後に、数値だけのtxtファイルとそれ以外のtxtファイルを別々に作成し、保存するプログラムを組みたいのですがよく分かりません。 ちなみに、使っているOSとAPはWinXP、Excel2003です。 InputData.txtの内容 A34bFg7p0 あ 1ylut890 B45LK4L え Number.txtの完成形 34701890 454 String.txtの完成形 AbFgp あ ylut BLKL え '変数の宣言 Dim myFile, myText, myList(), myList2(), str, B, C As String Dim XX As Integer Dim myFunc As Boolean Dim cnt, i As Long On Error GoTo myError myFile = Dir("InputDama.txt") 'ファイルの読み込み If myFile = "InputDama.txt" Then Open myFile For Input As #1 Do While Not EOF(1) Line Input #1, myText If myText <> "" Then If cnt = 0 Then ReDim myList(cnt), myList2(cnt) Else ReDim Preserve myList(UBound(myList) + 1), myList2(UBound(myList2) + 1) End If '数字・文字列の分類 CC = Len(myText) For XX = 1 To CC str = Mid(myText, XX, 1) If IsNumeric(str) = True Then '←数字かどうかはIsNumericで判断 B = B & str Else C = C & str End If Next myList(cnt) = B myList2(cnt) = C cnt = cnt + 1 End If Loop '書き込みファイルの作成 Open "Number.txt" For Output As #2 Open "String.txt" For Output As #3 For cnt = 0 To UBound(myList) Print #2, myList(cnt) Next cnt For cnt = 0 To UBound(myList2) Print #3, myList2(cnt) Next cnt Close #1, #2, #3 End Sub これだと、2行目に1行目で格納したデータが最後出てしまうので、それを取り除きたいのですが、効果的な方法が分かりませんので、宜しくお願いします。

  • macroについて教えてください

    こんにちは。以前こちらでPrivate SubについてMacroを教えていただきました。（あの後ログインパスワード等が不明になりお礼も出来ませんでしたが。。。回答頂いた方すみませんでした。） 下記がそのMacroですが、今回また少し変えることになり どのように変えていいのか分かりません。 前回は1～5はグレー、6～10は茶色・・・という形にしたのですが 今回は進捗率での管理をしたく、80％以下は白、80～90％は赤、90～100％は青としたいと思っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim iColors As Variant Dim rw As Long Dim CellCnt As Integer Dim col As Integer Dim col2 As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim c As Variant Dim ar() As Variant Dim Sh1 As Worksheet Set Sh1 = Worksheets("小児科Dr") col = Target.Cells(1).Column '制限された列 If Not (col = 4 Or col = 8 Or col = 12 Or col = 16) Then Exit Sub iColors = Array(16, 16, 16, 16, 16, 53, 53, 53, 53, 53, 54, 54, 54, 54, 54) CellCnt = Target.Count ReDim ar(CellCnt - 1) For Each c In Target If c.Value <> "" Then If IsNumeric(c.Value) Then i = c.Value If i >= 11 Then i = 10 End If If i > 0 And i < 11 Then j = iColors(i - 1) Else j = 2 End If ar(k) = j k = k + 1 End If End If Next c rw = Target.Row Select Case col Case 4: col2 = 2 Case 8: col2 = 8 Case 12: col2 = 14 Case 16: col2 = 20 'Sh1.Cells(rw + 2, 13).Resize(Int(Target.Count / 3), 3).Interior.ColorIndex = j End Select InsideColors Sh1, rw, col2, CellCnt, ar() Set Sh1 = Nothing End Sub Private Sub InsideColors(sh As Worksheet, _ rw As Long, _ col As Integer, _ cnt As Integer, _ ar As Variant) 'sh[シート],rw[行], col[列],cnt[セル個数],iColor[色指数] Dim i As Integer Dim j As Integer Dim n As Integer Dim k As Integer If cnt Mod 5 > 0 Then '範囲行数 i = (cnt + 5 - (cnt Mod 5)) / 5 Else i = cnt / 5 End If rw = Int((rw - 1) / 5) + 1 '行再設定 j = ((rw - 1) Mod 5) + 1 '列設定 For n = j To cnt sh.Cells(rw + 2, col).Resize(i, 5).Cells(n).Interior.ColorIndex = ar(k) k = k + 1 Next n End Sub 毎回他の人を頼ってしまい、申し訳ないのですがお願いします。 また、前回分からなかったので1～5を指定するときに5回同じカラー番号を書いたのですがこちらも良かったら手直し方法を教えていただければ助かります。 宜しくお願いします。

  • アクセスのフォームで10件づつ表示する。

    初めて書き込みさせて頂きます。 アクセスのテーブルを帳票形式にて作成して10件づつ表示をさせようとすると一部のデータが表示されません。 方法としては、帳票形式で10件のみ表示出来る様にサイズを調整して「前へ」と「次へ」のボタンをつけて10件づつ表示させています。 ソースは下記の方法で 「次へ」 Private Sub コマンド13_Click() Dim rs As DAO.Recordset, i As Integer Const n As Integer = 10 Set rs = Me.RecordsetClone For i = 1 To n * 2 If rs.EOF Then rs.MoveLast Me.Bookmark = rs.Bookmark Exit Sub End If rs.MoveNext Next Me.Bookmark = rs.Bookmark For i = 1 To n rs.MovePrevious Next Me.Bookmark = rs.Bookmark rs.Close End Sub 「前へ」 Private Sub コマンド16_Click() Dim rs As DAO.Recordset, i As Integer Const n As Integer = 10 Set rs = Me.RecordsetClone For i = 1 To n * 2 If rs.BOF Then rs.MoveFirst Me.Bookmark = rs.Bookmark Exit Sub End If rs.MovePrevious Next Me.Bookmark = rs.Bookmark For i = 1 To n rs.MoveNext Next Me.Bookmark = rs.Bookmark rs.Close End Sub 以上、ご教授の程宜しくお願い致します。

  • VBAの処理が止まる原因と対策を知りたい

    現在以下のとおりのVBAを動かしいますが、途中でフリーズしてしまうため、 原因が特定できずに困っています。 その原因と対策もしくは、原因を突き止める方法をご教授いただければと思います。 ・サーバ上にあるブックを4つ開く（BookA、BookB、BookC、BookD） ・BookAに記載している文字列を配列に入れる ・BookB上にて、前述の文字列を検索し、そのアドレスを取得（後述の関数B） ・BookB上にて、前述のアドレスから別の文字列を取得（後述の関数A） となります。なお「Application.ScreenUpdatingの停止」と「Application.Calculationを手動」は実施しましたが、改善しませんでした。 以下環境、状況、VBAの記述になります。 環境 OS：Windows7 64bit CPU：i3 メモリ：8GB EXCEL：2010 状況 ・関数Aから関数Bを呼んだ後にフリーズしている模様です（関数Bを呼ぶところまでは、確認できますが、その後フリーズをするため、関数Aに戻っているかは不明です）。 ・フリーズ時のEXCEL.EXEのCPU使用率は25%で固定です。 関数A Function Test1(WS1 As Worksheet, Str1() As String, Str2() As String) Dim i As Integer Dim Row As Integer, Co As Integer Dim Temp_Range As Range Dim Temp_Str As String For i = 1 To UBound(Str2) ReDim Preserve Str1(i) Temp_Str = Test2(WS1, Str2(i - 1)) If Temp_Str <> "ない" And Temp_Str <> "重複" Then Set Temp_Range = WS1.Range(Temp_Str) If Temp_Range.MergeCells Then Co = Temp_Range.Column + Temp_Range.MergeArea.Count - 1 Else Co = Temp_Range.Column End If 　　Row = Temp_Range.Row Str1(i - 1) = WS1.Cells(Row, Co).Offset(0, 1).Value End If Next i End Function 関数B Function Test2(WS1 As Worksheet, Str1 As String) As String Dim temp As Range Dim a, b As Boolean Dim r As String Dim i, j As Integer Set temp = WS1.UsedRange For i = 1 To temp.Rows(temp.Rows.Count).Row For j = 1 To temp.Columns(temp.Columns.Count).Column If Replace(WS1.Cells(i, j).Value, vbLf, "") = Replace(Str1, vbLf, "") Then If a = False Then r = WS1.Cells(i, j).Address a = True Else r = "重複" b = True Exit For End If End If Next If b = True Then Exit For Next If r = "" Then r = "ない" Test2 = r End Function

  • 写真を縦に取り込むには？

    質問１ 写真を縦に取り込むには以下マクロをどのように変えたらよいのか？ を教えてください。 質問２ ＪＰＧとｊｐｇを取り込むにはどうしたらよいのでしょうか？ Sub test01() ListUp_FileList ("C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures") End Sub Sub ListUp_FileList(FolderSpec) Dim File_Collection As Object Dim File_List As Variant Dim cnt As Integer Set File_Collection = CreateObject("Scripting.FileSystemObject") _ .GetFolder(FolderSpec).Files cnt = 1 l = 10 For Each File_List In File_Collection If Right(File_List, 4) = ".jpg" Then 'Range("A" & Format(cnt)) = File_List.Name ActiveSheet.Pictures.Insert(FolderSpec & "\" & File_List.Name).Select Selection.ShapeRange.Left = l + (cnt - 1) * 150 Selection.ShapeRange.Width = 130 Selection.ShapeRange.Height = 104 Selection.ShapeRange.Top = 360 cnt = cnt + 1 End If Next End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する