0

リストボックスに結果を表示するSQLクエリのソースにしたい複数選択リストボックスがあります。現在、1 つのフィールドが 1 つだけ選択されている場合に美しく表示されるレコードセットに結果が送られます。たとえば、ユーザーが [性別] を選択すると、レコードセット データシートは開かれず、List20 にはフィールド名が下線付きで表示され、その下に個別の値が表示されます。複数のアイテムを選択しようとすると、うまくいきません。たとえば、選択された 2 つの項目 (Gender、Interface) は Gender (下線付き) になりますが、その下に 2 つの F と 2 つの M があり、Interface フィールドの値はありません。各選択をループしてリストボックスに表示するにはどうすればよいですか? これが私のコードです。また、奇妙なことに、クエリを実行しても List13 には結果が表示されませんが、次の行を削除すると、Me.List13 を設定します。Recordset = rs レコードセット データシートが開き、必要な結果が List20 に表示されなくなります。助けてください！

Private Sub Command19_Click()
Dim strSQL As String
Dim strCriteria As String
Dim varItem As Variant
Dim dbs As Database
Set dbs = CurrentDb()
Dim qdf As QueryDef
Dim rs As Recordset

On Error GoTo Err_Command19_Click

For Each varItem In Me!List101.ItemsSelected
strCriteria = strCriteria & ",'" & Me!List101.ItemData(varItem) & "'"
Next varItem

strCriteria = Right(strCriteria, Len(strCriteria) - 1)

strSQL = "SELECT DISTINCT " & strCriteria & " FROM Scrubbed"
strSQL = Replace(strSQL, "'", "")

Set rs = dbs.OpenRecordset(strSQL)
Do Until rs.EOF
Set Me.List20.Recordset = rs
Set Me.List13.Recordset = rs
Loop

With dbs
Set qdf = .CreateQueryDef("TmpDistinctValues", strSQL)
DoCmd.OpenQuery "TmpDistinctValues"
.QueryDefs.Delete "TmpDistinctValues"
End With
dbs.Close
qdf.Close

Exit_Command19_Click:
   Exit Sub
Err_Command19_Click:
    MsgBox "Please select a field"

End Sub
4

1 に答える 1

0

確かにあなたは意味します：

For Each varItem In Me!List101.ItemsSelected
   strCriteria = strCriteria & "," & Me!List101.ItemData(varItem) 
   colcount = colcount + 1
   colwidths = colwidths & ";" & "1134"
Next varItem

strCriteria = Right(strCriteria, Len(strCriteria) - 1)

strSQL = "SELECT DISTINCT " & strCriteria & " FROM Scrubbed"
''strSQL = Replace(strSQL, "'", "")

''Set rs = dbs.OpenRecordset(strSQL)
''Do Until rs.EOF
Me.List20.RowSource = strSQL
Me.List20.ColumnCount = colcount
Me.List20.ColumnWidths = Mid(colwidths, 2)

''Set Me.List13.Recordset = rs
''Loop
于 2012-08-01T20:40:18.363 に答える