E có đoạn mã lấy dữ liệu vách từ file mdb. E muốn lọc dữ liệu tên vách từ ô giá trị nhập Excel nhưng code ko chạy đc. A giúp e với ha.
Sub FromAccessTableCOLUMN(DBFullName As String, TargetRange As Range)
Dim i
Dim cn As ADODB.Connection, Rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set Rs = New ADODB.Recordset
With Rs
.Open "SELECT [Pier Forces].story,[Pier Forces].pier,[Pier Forces].load,[Pier Forces].p,[Pier Forces].v2,[Pier Forces].v3,[Pier Forces].m2,[Pier Forces].m3,[Pier Section Properties].ThickBot,[Pier Section Properties].WidthBot,[Pier Section Properties].CGBotZ,[Pier Section Properties].CGTopZ,[Control Parameters].CurrUnits,[Control Parameters].CurrUnits FROM [Pier Forces],[Pier Section Properties],[Control Parameters] WHERE [Pier Forces].pier = [Pier Section Properties].pier and [Pier Forces].story=[Pier Section Properties].story", cn, , , adCmdText
.MoveFirst
Rs.Filter = "Pier = Sheet6.Cells(3, 3)"
i = 20
i = i
Range("a21").Select
Do
Range("a20:w20").Copy TargetRange.Offset(i, 0)
TargetRange.Offset(i, 0).Activate
Cells(i, 1).Value = .Fields(0).Value 'Ten tang
Cells(i, 2).Value = .Fields(1).Value 'Ten vach
Cells(i, 3).Value = .Fields(2).Value 'Combo
If .Fields(12).Value = "KN-m" Then
Cells(i, 4).Value = .Fields(3).Value 'p
Cells(i, 5).Value = .Fields(4).Value 'v2
Cells(i, 6).Value = .Fields(5).Value 'v3
Cells(i, 7).Value = .Fields(6).Value 'm2
Cells(i, 8).Value = .Fields(7).Value 'm3
Else
Cells(i, 4).Value = 9.81 * .Fields(3).Value 'p
Cells(i, 5).Value = 9.81 * .Fields(4).Value 'v2
Cells(i, 6).Value = 9.81 * .Fields(5).Value 'v3
Cells(i, 7).Value = 9.81 * .Fields(6).Value 'm2
Cells(i, 8).Value = 9.81 * .Fields(7).Value 'm3
End If
Cells(i, 9).Value = .Fields(8).Value 'b
Cells(i, 10).Value = .Fields(9).Value 'h
Cells(i, 12).Value = .Fields(11).Value - .Fields(10).Value 'l
.MoveNext
i = i + 1
Loop Until .EOF
Range("a2").Select
End With
Rs.Close
Set Rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Sub FromAccessTableCOLUMN(DBFullName As String, TargetRange As Range)
Dim i
Dim cn As ADODB.Connection, Rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set Rs = New ADODB.Recordset
With Rs
.Open "SELECT [Pier Forces].story,[Pier Forces].pier,[Pier Forces].load,[Pier Forces].p,[Pier Forces].v2,[Pier Forces].v3,[Pier Forces].m2,[Pier Forces].m3,[Pier Section Properties].ThickBot,[Pier Section Properties].WidthBot,[Pier Section Properties].CGBotZ,[Pier Section Properties].CGTopZ,[Control Parameters].CurrUnits,[Control Parameters].CurrUnits FROM [Pier Forces],[Pier Section Properties],[Control Parameters] WHERE [Pier Forces].pier = [Pier Section Properties].pier and [Pier Forces].story=[Pier Section Properties].story", cn, , , adCmdText
.MoveFirst
Rs.Filter = "Pier = Sheet6.Cells(3, 3)"
i = 20
i = i
Range("a21").Select
Do
Range("a20:w20").Copy TargetRange.Offset(i, 0)
TargetRange.Offset(i, 0).Activate
Cells(i, 1).Value = .Fields(0).Value 'Ten tang
Cells(i, 2).Value = .Fields(1).Value 'Ten vach
Cells(i, 3).Value = .Fields(2).Value 'Combo
If .Fields(12).Value = "KN-m" Then
Cells(i, 4).Value = .Fields(3).Value 'p
Cells(i, 5).Value = .Fields(4).Value 'v2
Cells(i, 6).Value = .Fields(5).Value 'v3
Cells(i, 7).Value = .Fields(6).Value 'm2
Cells(i, 8).Value = .Fields(7).Value 'm3
Else
Cells(i, 4).Value = 9.81 * .Fields(3).Value 'p
Cells(i, 5).Value = 9.81 * .Fields(4).Value 'v2
Cells(i, 6).Value = 9.81 * .Fields(5).Value 'v3
Cells(i, 7).Value = 9.81 * .Fields(6).Value 'm2
Cells(i, 8).Value = 9.81 * .Fields(7).Value 'm3
End If
Cells(i, 9).Value = .Fields(8).Value 'b
Cells(i, 10).Value = .Fields(9).Value 'h
Cells(i, 12).Value = .Fields(11).Value - .Fields(10).Value 'l
.MoveNext
i = i + 1
Loop Until .EOF
Range("a2").Select
End With
Rs.Close
Set Rs = Nothing
cn.Close
Set cn = Nothing
End Sub