アプリ版:「スタンプのみでお礼する」機能のリリースについて

困っていますよろしくお願いします。
やりたいことなのですが、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

A 回答 (3件)

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

    • good
    • 0

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

    • good
    • 0

カレントと次に限定した動きで良いでしょうか。



言葉だけで伝えるには、私には難しいのでコードを記述します。
「カレントと次」 の表現されていますが、提示するコードでの考え方は、
「前とカレント」としており、カレントを削除する/しない としています。

以下、テーブル「T1」のサンプルとします。
id が 5, 6 の field2 は NULL
id が 7, 8 の field2 は ""

とした時、

idfield1field2
1aaaabbbb
2aaaabbbb
3aaaabbbb
4aaaabbbb
5aaaa
6aaaa
7aaaa
8aaaa
9aaaacccc

↓ 以下 Sample1 を1回実行

id = 2 を削除した時点で、カレント/次の関係が無くなるので
リセットした状態で id = 3 を覚える処理になっています。

idfield1field2
1aaaabbbb
3aaaabbbb
5aaaa
7aaaa
9aaaacccc

↓ 以下 Sample1 をさらに1回実行

テキスト系のフィールドでは、NULL と "" は同じ、
数値系のフィールドでは、NULL と 0 は同じとしています。

idfield1field2
1aaaabbbb
5aaaa
9aaaacccc


以下、処理記述サンプル(一例)になります。
(どんどん修正していってください)

' 前のデータを覚えておくもの
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 以外を比較対象に)


カレント/次の関係に限定せずに、連続して同じものがあるか処理する時には
上記 ★ 部分をコメントにしてください。

動きは以下の様になります。

idfield1field2
1aaaabbbb
2aaaabbbb
3aaaabbbb
4aaaabbbb
5aaaa
6aaaa
7aaaa
8aaaa
9aaaacccc

↓ 以下 Sample1 を1回実行

idfield1field2
1aaaabbbb
5aaaa
9aaaacccc
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!