• 締切済み

困っていますよろしくお願いします。

困っていますよろしくお願いします。 やりたいことなのですが、accessテーブルのレコードをカレントレコードと次のレコードと言ったように1レコードずつ比較して、すべてのフィールド値が2つのレコード間で同じであればレコードの削除、1つでも値がちがえば削除しないと言うプログラムを組みたいと思っています。(2つのレコードの各フィールドの値を比較し違いがあればそのレコードを残したいので別テーブルへの追加でもかまいません) 下記のプログラムのようにDLookup関数を使用し"商品"のように1フィールドであれば次のレコードとの比較が可能なのですが、DLookup関数を使って複数フィールドを次のレコードと比較することが出来るのでしょうか? また、出来ないのであればほかにどのような比較方法があるのでしょうかお助けくださいよろしくお願いします。(IDフィールドはオートナンバーです) Dim a As String Dim b As String Dim c As String Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset rs.Open "T_履歴", cn, adOpenKeyset, adLockOptimistic rs.MoveFirst a = rs!ID Do Until rs.EOF b = DLookup("商品", "T_履歴", "ID = " & a) c = DLookup("商品", "T_履歴", "ID = " & a + 1) If b = c Then rs.Delete Else rs.Delete rs.MoveNext End If a = a + 1 rs.MoveNext Loop rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing

みんなの回答

  • 30246kiku
  • ベストアンサー率73% (370/504)
回答No.3

カレントと次に限定した動きで良いでしょうか。 言葉だけで伝えるには、私には難しいのでコードを記述します。 「カレントと次」 の表現されていますが、提示するコードでの考え方は、 「前とカレント」としており、カレントを削除する/しない としています。 以下、テーブル「T1」のサンプルとします。 id が 5, 6 の field2 は NULL id が 7, 8 の field2 は "" とした時、 id field1 field2 1 aaaa bbbb 2 aaaa bbbb 3 aaaa bbbb 4 aaaa bbbb 5 aaaa 6 aaaa 7 aaaa 8 aaaa 9 aaaa cccc ↓ 以下 Sample1 を1回実行 id = 2 を削除した時点で、カレント/次の関係が無くなるので リセットした状態で id = 3 を覚える処理になっています。 id field1 field2 1 aaaa bbbb 3 aaaa bbbb 5 aaaa 7 aaaa 9 aaaa cccc ↓ 以下 Sample1 をさらに1回実行 テキスト系のフィールドでは、NULL と "" は同じ、 数値系のフィールドでは、NULL と 0 は同じとしています。 id field1 field2 1 aaaa bbbb 5 aaaa 9 aaaa cccc 以下、処理記述サンプル(一例)になります。 (どんどん修正していってください) ' 前のデータを覚えておくもの Dim vData() As Variant Dim bStock As Boolean ' 削除対象か判別、対象なら True を返す Private Function CheckData(fld As ADODB.Fields) As Boolean   Dim i As Integer   CheckData = False   If (bStock = True) Then     For i = 1 To UBound(vData)       If (Nz(vData(i)) <> Nz(fld(i))) Then         CheckData = True         Exit For       End If     Next     CheckData = Not CheckData   End If   bStock = False ' ★   If (CheckData = False) Then     For i = 1 To UBound(vData)       vData(i) = fld(i)     Next     bStock = True   End If End Function Private Sub Sample1()   Dim rs As New ADODB.Recordset   rs.Open "T1", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic   ReDim vData(1 To rs.Fields.Count - 1)   bStock = False   While (Not rs.EOF)     If (CheckData(rs.Fields)) Then rs.Delete     rs.MoveNext   Wend   rs.Close End Sub ※ レコードセットで得られる id は、1つ目にあるものと限定しています。 (id 以外を比較対象に) ※ カレント/次の関係に限定せずに、連続して同じものがあるか処理する時には 上記 ★ 部分をコメントにしてください。 動きは以下の様になります。 id field1 field2 1 aaaa bbbb 2 aaaa bbbb 3 aaaa bbbb 4 aaaa bbbb 5 aaaa 6 aaaa 7 aaaa 8 aaaa 9 aaaa cccc ↓ 以下 Sample1 を1回実行 id field1 field2 1 aaaa bbbb 5 aaaa 9 aaaa cccc

  • ShowMeHow
  • ベストアンサー率28% (1424/5027)
回答No.2

失礼、「ID」が重複していないならIDは「先頭」でも選んでおいてください。

  • ShowMeHow
  • ベストアンサー率28% (1424/5027)
回答No.1

すべての項目でグループ化して、別テーブルに出力するとお望みのことができると思います。

関連するQ&A

  • オープンしているレコードセットの中の最大値

    VB6でAccess2000です Dim RS As ADODB.Recordset Dim SQL,CN As String RS.Open SQL, CN, adOpenStatic という形で一度オープンしてしまったレコードセットにIDフィールドがあり、その最大値を取得したい場合、どのような方法を用いればいいのでしょうか?

  • ACCESS ADOのMovePreviousについて

    毎度お世話になっております。 ACCESS2003を使用しています。 ACCESS ADOにて、レコードセットがeofになった後、 MovePreviousをし、MoveNextをし、 さらにもう一度MovePreviousをすると、 最終レコードの一つ前に戻ってしまいます。 テーブル1 フィールド1 フィールド2    1     あ    2     い    3     う    4     え    5     お コード Sub test()   Dim cn As New ADODB.Connection   Dim rs As New ADODB.Recordset   Set cn = CurrentProject.Connection   rs.Open "select * from テーブル1 order by フィールド1", cn, adOpenDynamic, adLockReadOnly   Do Until rs.EOF    rs.MoveNext   Loop   rs.MovePrevious   Debug.Print rs.Fields("フィールド1").Value   rs.MoveNext   rs.MovePrevious   Debug.Print rs.Fields("フィールド1").Value   rs.Close: Set rs = Nothing   cn.Close: Set cn = Nothing End Sub 一度目のdebug.printは5に、 二度目のdebug.printは4になります。 このような仕組みなのでしょうか。 ご教授お願いいたします。

  • ADOでレコードを閉じるタイミング。。Access2000/VB6/Win2K

    レコードセットを返すFuncitonプロシージャーを作ってみたのですが。。。 下のGet_Recordsの方のレコードセットをCloseすると上の方のDisp_Dataでオブ ジェクトが閉じているといって怒られます。しかし、閉じないと下の方では開きっ ぱなしになると思うのですが。。。どのように処理すればいいのでしょうか? Public P_CN As ADODB.Connection Private Sub Disp_Date()   Dim RS As ADODB.Recordset   Dim SQL AS String    Set RS = Get_Records(SQL)     With RS      If .RecordCount > 0 Then       .MoveLast: .MoveFirst       .Debug.Print !顧客_ID        End If      End With      RS.Close     Set RS = Nothing End Sub Public Function Get_Records(pSQL As String) As ADODB.Recordset   Dim RS As ADODB.Recordset     Set RS = New ADODB.Recordset      RS.Open pSQL, P_CN, adOpenKeyset, adLockOptimistic     Set Get_Records = RS '''    RS.Close '''   Set RS = Nothing End Function

  • ADOで現在のレコードの次のレコードの値も取得

    ADOで現在のレコードの次のレコードの値も取得するには? アクセスに対してADOでデータを取得しているのですが 例えばテーブルに フィールド1 あああ いいい ううう と入ってる時に、1レコード目のあああの値を取得しているときに、同時に次のレコードのいいいの値も取得することは可能ですか? Sub Sample() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Set cn = CurrentProject.Connection rs.Open "SELECT * FROM テーブル1", cn, adOpenStatic, adLockPessimistic For i = 1 To rs.RecordCount MsgBox rs("フィールド1") '現在のレコード MsgBox rs("フィールド1") + 1 '次のレコード rs.MoveNext Next rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub これだとダメなようです。 あああ いいい が表示されるようにしたいのですが、どうすればいいか教えてください。

  • VBAのデバックをどなたかお手伝いください。

    もちろん自分でも調べてはいるのですが、急いでいるため、もしどなたか教えてくだされば大変助かります。 この(下記の)Then 以降からがわかりません。 Do Until rs.EOF '該当レコードあり If rs!MCD = "3162" Then '--------------------------------------------- strcriteria = "CAT = '" & rs!CAT & "'" ' --- A rs2.Find strcriteria, 0, adSearchForward If rs2.EOF Then ' Else rs!仕入単価世代1 = rs!仕入単価 rs!仕入単価 = rs2!discount End If '--------------------------------------------- rs!更新日 = Now() rs.Update End If 情報が不足していればお答えします。どうぞ宜しくお願いいたします。 (補足)これより前に入力されているのは以下のものです。 Dim cn As ADODB.Connection Dim cn2 As ADODB.Connection Dim rs As ADODB.Recordset Dim rs2 As ADODB.Recordset Dim strmsg As String Dim lngRet As Long Dim strcriteria As String Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset Set cn2 = CurrentProject.Connection Set rs2 = New ADODB.Recordset rs.Open "商品2_T", cn, adOpenKeyset, adLockOptimistic rs2.Open "商品2_T25discountてすと", cn2, adOpenKeyset, adLockOptimistic

  • recordsetが取得できなかった場合

    Access2003のVBAについて質問です。 recordsetが取得できなかった場合、どういった値が返されるのでしょうか? やりたい事は、recordsetが取得できた時、できなかった時でメッセージの表示を変えたいです。 ご教授よろしくおねがいします。 Public Sub Exsample() Dim CN As ADODB.Connection Dim RS As ADODB.Recordset Dim SQL As String '接続 Set CN = CurrentProject.Connection 'レコードセットを取得 Set RS = New ADODB.Recordset SQL = "SELECT * FROM 生徒名簿 WHERE クラス = 'TS'" RS.Open SQL, CN, adOpenKeyset, adLockOptimistic

  • Access ADOについて質問です。

    Access ADOについて質問です。 以下コードでレコードセットを返す関数を使用しています。 動作的には問題ないのですが、標準モジュール内のレコードセットをClose及びNothingしていないのが気になります。 Private Sub Form_Open(Cancel As Integer) Dim rs2 As ADODB.Recordset Set rs2 = New ADODB.Recordset Set rs2 = CreateRecordSet("SELECT * FROM T_Standard;") Set Me.Recordset = rs2 rs2.Close: Set rs2 = Nothing end sub '標準モジュール Public Function CreateRecordSet(strSQL As String) As ADODB.Recordset Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection cn.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=O:\標準DB\StandardBackEnd.mdb" cn.Open Set rs = New ADODB.Recordset rs.Open strSQL, cn, adOpenStatic, adLockReadOnly Set CreateRecordSet = rs ' rs.Close: Set rs = Nothing   ←この部分 ' cn.Close: Set cn = Nothing   ←この部分 End Function 標準モジュール内ではCloseやNothingしなくてもメモリの開放は行われているのでしょうか? アドバイスよろしくお願いいたします。

  • access ふたつのテーブル間でのデータ移動VB

    win10 office365 accessのテーブルの table1のフィールド IDの数値を table2のフィールド ID (いずれも長整数型 数値型 重複あり 空白の許容なし) にコピーする操作ですが 幾度か お尋ねしてきていますが 今回 このやり方で やってみました http://www.mahoutsukaino.com/ac/ac2002/vba/vba16/v16.htm 以下のコードにおいて rs2.Update ここの部分が黄色くなって とまってしまいます しかし なぜか 数値の移行は 出来ていました ただ止まってしまうと 次に続けられなく困っています Public Function table2table1() Dim cn As adodb.Connection Dim rs1 As adodb.Recordset Dim rs2 As adodb.Recordset Set cn = Application.CurrentProject.Connection Set rs1 = New adodb.Recordset Set rs2 = New adodb.Recordset rs1.Open "table1", cn, adOpenStatic, adLockReadOnly rs2.Open "table2", cn, adOpenKeyset, adLockOptimistic rs1.MoveFirst Do Until rs1.EOF rs2.Find "ID='" & rs1!ID & "'" If rs2.EOF Then rs2.AddNew rs2![ID] = rs1![ID] rs2.Update End If rs1.movenext Loop rs1.Close rs2.Close cn.Close End Function 以上 すみません 宜しくお願い致します

  • ODBCでMoveNextがうまく動作しないようなのですが

    まだVB歴1年ないので説明もうまくできないかも知れませんが どなたか教えていただければ助かります。 Dim cn as ADODB.Connection Dim rs as ADODB.Recordset Set cn = New ADODB.Connection cn.IsolationLevel = adXactRepeatabelRead cn.Open ***** Set rs = New ADODB.Recordset rs.CursorType = adOpenDynamic rs.LockType = asLockPessimistic rs.ActiveConnection = cn rs.Open ***** 上記のように設定したのち データ読み込み rs.MoveFirst Do until rs.EOF aaa = rs.Fields("ID").Value    中略 rs.MoveNext Loop ファイルクローズして他の処理したのち 再びファイルオープンして rs.MoveFirst For *** Set rs = cn.Execute("UPDATE テーブル名 SET ID = ***** ") 中略 rs.MoveNext Next *** ファイルクローズ 上記のMoveNextがおかしいと思うのですが 他のところかもしれませんが悩んでいます。 この内容でわかっていただけるか心配ですが よろしくお願いします。

  • ADOでエクセルからSQL Serverへデータを移行するには

    エクセルvbaのADOを使って、 SQL Serverの「test」という名のデータベースの「Table_1」に 新規レコードを追加する事はできますか? エクセルからアクセスには Sub test() Dim データベース名 As String Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordset cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & データベース名 rs.Open "Tテーブル1", cn, adOpenKeyset, adLockOptimistic rs.AddNew rs.Fields("フィールド1") = データ rs.Update rs.Close cn.Close Set rs = Nothing Set cn = Nothing End Sub で移行しています。 これをエクセルからSQL Serverへ移行させるにはどうすればいいのでしょうか? よろしくお願いします。

専門家に質問してみよう