Xin nhờ xem giúp code về ADO

Liên hệ QC
N

ngothanhluan

Thành viên chính thức
Tham gia
25/6/13
Bài viết
70
Được thích
3
Em có 2 file, 1 file HANG HOA chứa dữ liệu hàng hóa, 1 file kia dùng để lấy hoặc chỉnh sửa dữ liệu, file TEST em có viết đoạn code ADO như sau nhưng bị báo lỗi, không biết bị sai chỗ nào mong mọi người giúp đỡ.
Mã: 
Sub update()    
Dim cnn As ADODB.Connection
    Dim FileFullName As String
    Set cnn = New ADODB.Connection
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    cnn.Execute ("UPDATE DS_HH SET TEN_SP='ALO123' WHERE MA_SP=10003")
    MsgBox cnn.State
End Sub
 

File đính kèm

  • HANG HOA.xlsm
    40.3 KB · Đọc: 32
  • TEST.xlsm
    14.7 KB · Đọc: 34
Sắp xếp theo thời gian sắp xếp theo bầu chọn
doveandrose đã viết:
máy tôi dùng code bài #17 không chỉnh sửa gì code chạy ào ào mới ghê

2f879204222492f145521c4cbe27b87c.png
Nhấp chuột vào đây để mở rộng...
À em tìm được nguyên nhân rồi, làm phiền mấy anh quá.:))
 
Lần chỉnh sửa cuối:
Upvote 0
Cho em hỏi, đoạn code dưới sai chỗ nào mà search trong combobox khong co tac dung. Mong các anh giải đáp giúp.
p/s: Em có gửi file đính kèm, mấy anh xem thử.
Mã: 
Private khArray
Private Sub DS_KH() 'khoi tao bang danh sach kh va no dau ky
Dim cnnAcc As ADODB.Connection
Dim rcdTEMP As ADODB.Recordset
Dim sPath As String


    Set cnnAcc = New ADODB.Connection


    sPath = Application.ThisWorkbook.Path & "\TONG.accdb"
    
    With cnnAcc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=Yes"";"
        .Open
        
    End With
    
    Set rcdTEMP = New ADODB.Recordset
    Set rcdTEMP = cnnAcc.Execute("SELECT MA_KH,TEN_KH,MA_NVKD,NVKD,NO_DAU_KY FROM DS_KH")
    
    ComboBox1.Column = rcdTEMP.GetRows()
    khArray = ComboBox1.List()
    
    Set rcdTEMP = Nothing
    
    cnnAcc.Close


End Sub
Private Sub ComboBox1_Change() 'search ma KH
On Error Resume Next


    With ComboBox1
    
        khArray = NewAutoFilter(khArray, xlNo, 2, "*" & ComboBox1.Text & "*")
        .List() = khArray
        .DropDown
        
    End With
    
End Sub


Private Sub UserForm_Activate()
    Call DS_KH
End Sub
 

File đính kèm

  • BH.rar
    140.6 KB · Đọc: 6
Upvote 0
ngothanhluan đã viết:
Cho em hỏi, đoạn code dưới sai chỗ nào mà search trong combobox khong co tac dung. Mong các anh giải đáp giúp.
p/s: Em có gửi file đính kèm, mấy anh xem thử.
Mã: 
Private [COLOR=#ff0000][B]khArray[/B][/COLOR]
Private Sub DS_KH() 'khoi tao bang danh sach kh va no dau ky
Dim cnnAcc As ADODB.Connection
Dim rcdTEMP As ADODB.Recordset
Dim sPath As String


    Set cnnAcc = New ADODB.Connection


    sPath = Application.ThisWorkbook.Path & "\TONG.accdb"
    
    With cnnAcc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=Yes"";"
        .Open
        
    End With
    
    Set rcdTEMP = New ADODB.Recordset
    Set rcdTEMP = cnnAcc.Execute("SELECT MA_KH,TEN_KH,MA_NVKD,NVKD,NO_DAU_KY FROM DS_KH")
    
    ComboBox1.Column = rcdTEMP.GetRows()
    [COLOR=#ff0000][B]khArray [/B][/COLOR]= ComboBox1.List()
    
    Set rcdTEMP = Nothing
    
    cnnAcc.Close


End Sub
Private Sub ComboBox1_Change() 'search ma KH
On Error Resume Next


    With ComboBox1
    
        [B][COLOR=#ff0000]khArray [/COLOR][/B]= NewAutoFilter([B][COLOR=#ff0000]khArray[/COLOR][/B], xlNo, 2, "*" & ComboBox1.Text & "*")
        .List() = [B][COLOR=#ff0000]khArray[/COLOR][/B]
        .DropDown
        
    End With
    
End Sub


Private Sub UserForm_Activate()
    Call DS_KH
End Sub
Nhấp chuột vào đây để mở rộng...

Sao bạn không dùng Mảng tạm để thay thế sau khi lọc? Vì nếu đã lọc rồi, tức rút gọn lại rồi làm sao mà lọc tiếp đây?

Mã: 
Private Sub ComboBox1_Change() 'search ma KH
On Error Resume Next
Dim ArrTmp

    With ComboBox1
    
        [COLOR=#0000ff][B]ArrTmp[/B][/COLOR]= NewAutoFilter([B][COLOR=#FF0000]khArray[/COLOR][/B], xlNo, 2, "*" & ComboBox1.Text & "*")
        .List() = [B]ArrTmp[/B]
        .DropDown
        
    End With
    
End Sub

p/s: Tôi chỉ nhìn code rồi nói vậy, chưa test.
 
Upvote 0
Dạ em có chuyển sang dùng mảng tạm nhưng cũng không thấy search được. Anh xem giúp em với.
 
Upvote 0
ngothanhluan đã viết:
Dạ em có chuyển sang dùng mảng tạm nhưng cũng không thấy search được. Anh xem giúp em với.
Nhấp chuột vào đây để mở rộng...
Đối với mảng dạng này nó phải làm khác thôi, không dùng hàm NewAutoFilter được đâu.

Mã: 
Private Sub ComboBox1_Change() 'search ma KH
'On Error Resume Next
    Dim ArrTmp, GetRow()
    Dim n As Long, r As Long
    Dim c As Byte, col As Byte
    col = LBound(khArray, 2) [COLOR=#ff0000][B]+ 1 [/B][/COLOR][COLOR=#006400][B]'Lọc cột 2[/B][/COLOR][COLOR=#ff0000][/COLOR]
    With ComboBox1
        For r = LBound(khArray, 1) To UBound(khArray, 1)
            If UCase(khArray(r, col)) Like "*" & UCase(.Text) & "*" Then
                n = n + 1
                ReDim Preserve GetRow(1 To n)
                GetRow(n) = r
            End If
        Next
        If n Then
            Dim lbd As Byte, ubd As Byte
            lbd = LBound(khArray, 2)
            ubd = UBound(khArray, 2)
            ReDim ArrTmp(1 To n, lbd To ubd)
            For r = 1 To n
                For c = lbd To ubd
                    ArrTmp(r, c) = khArray(GetRow(r), c)
                Next
            Next
            .List() = ArrTmp
        End If
    End With
    
End Sub

Với số +1, nếu bạn muốn lọc ở cột 2 thì +1, cột 3 thì +2 cứ như thế, nếu lọc cột 1 thì không cộng gì cả.
 
Upvote 0
Cảm ơn anh Nghĩa đã giúp, nhưng Anh Nghĩa giải thích rõ hơn vì sao lại như vậy không ạ. Mảng này có gì khác thường. Mong anh giải đáp để em được học hỏi thêm.
 
Upvote 0
ngothanhluan đã viết:
Cảm ơn anh Nghĩa đã giúp, nhưng Anh Nghĩa giải thích rõ hơn vì sao lại như vậy không ạ. Mảng này có gì khác thường. Mong anh giải đáp để em được học hỏi thêm.
Nhấp chuột vào đây để mở rộng...
Đơn giản là mảng của CSDL hoặc mảng trong List() nó có Cận đầu bắt đầu là 0 cho cột lẫn hàng, còn mảng ta xuất từ Range có Cận đầu bắt đầu là 1, mặc dù biết là như vậy, nhưng để đảm bảo nó như thế nào thì nên lấy cận đầu của nó (bao nhiêu (0 hay 1) tùy ý) , ta không quan tâm đến cận đầu, mà chỉ cần quan tâm đến cột thứ mấy ta cần, giả sử cận đầu là 0 thì đó là cột 1, mà ta cần cột 2 tức ta lấy cận 0 cộng thêm 1 là cột ta cần.

Cái hàm NewAutoFilter tôi làm hồi đó chỉ lường việc hàng mà chưa lường được tình huống cột này nên bị như thế.

Cho nên thủ tục vừa rồi sẽ tổng quát hơn cho mọi trường hợp dù là cận là 0 hay 1 đều OK.
 
Upvote 0
Anh Nghĩa ơi cho em hỏi đoạn code SQL dưới bị sai chỗ nào lại báo lỗi, em có gửi file kèm, mong anh xem giúp.
Mã: 
Private khArray
Private Sub UserForm_Activate()
Dim cnnAcc As ADODB.Connection
Dim rcdTEMP As ADODB.Recordset
Dim sPath As String


    Set cnnAcc = New ADODB.Connection


    sPath = Application.ThisWorkbook.Path & "\OF.accdb"
    
    With cnnAcc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=Yes"";"
        .Open
        
    End With


    Set rcdTEMP = New ADODB.Recordset


[COLOR=#ff0000]    Set rcdTEMP = cnnAcc.Execute("SELECT SUM(TONG_TIEN) FROM absc")

[/COLOR]
    TextBox1 = rcdTEMP.GetString()


    Set rcdTEMP = Nothing
    
    cnnAcc.Close
End Sub
 

File đính kèm

  • BH.rar
    79.6 KB · Đọc: 13
Upvote 0
ngothanhluan đã viết:
Anh Nghĩa ơi cho em hỏi đoạn code SQL dưới bị sai chỗ nào lại báo lỗi, em có gửi file kèm, mong anh xem giúp.
Mã: 
Private khArray
Private Sub UserForm_Activate()
Dim cnnAcc As ADODB.Connection
Dim rcdTEMP As ADODB.Recordset
Dim sPath As String


    Set cnnAcc = New ADODB.Connection


    sPath = Application.ThisWorkbook.Path & "\OF.accdb"
    
    With cnnAcc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=Yes"";"
        .Open
        
    End With


    Set rcdTEMP = New ADODB.Recordset


[COLOR=#ff0000]    Set rcdTEMP = cnnAcc.Execute("SELECT SUM(TONG_TIEN) FROM absc")

[/COLOR]
    TextBox1 = rcdTEMP.GetString()


    Set rcdTEMP = Nothing
    
    cnnAcc.Close
End Sub
Nhấp chuột vào đây để mở rộng...
Không nên đặt tên tiếng Việt có dấu trong CSDL, trong file Access của bạn có tên cột là Tổng Tiền nhưng trong câu truy vấn là TONG_TIEN nên gây lỗi.
 
Upvote 0
Ui cha, toàn sai mấy lỗi cơ bản, cảm ơn Anh Hai Lúa đã giúp.
 
Upvote 0
Anh Hai Lúa cho em hỏi, ngoài cách dùng vòng lặp For thì có cách nào khác để INSERT INTO 1 mảng dữ liệu vào trong tbl ACCESS không anh.
 
Upvote 0
Upvote 0
ngothanhluan đã viết:
Dạ em có gửi file đính kèm. tblCHI_TIET_NX đó anh. Anh xem thử giúp em ạ. Dữ liệu được ghi từ file excel vào ạ.
Nhấp chuột vào đây để mở rộng...
Tôi gửi ví dụ nhập vào bảng phiếu nhập, bạn theo đó mà biến chế nhé.
Mã: 
Sub PhieuNhap()

    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\OF.accdb"
    cn.Execute "INSERT INTO PHIEU_NHAP SELECT * FROM [Excel 8.0;DATABASE=" & ThisWorkbook.FullName & "].[PhieuNhap$]"


End Sub

ps: Tôi khai báo không tường minh nhé.
 

File đính kèm

  • Access.rar
    41.3 KB · Đọc: 16
Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Tôi gửi ví dụ nhập vào bảng phiếu nhập, bạn theo đó mà biến chế nhé.
Mã: 
Sub PhieuNhap()

    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\OF.accdb"
    cn.Execute "INSERT INTO PHIEU_NHAP SELECT * FROM [Excel 8.0;DATABASE=" & ThisWorkbook.FullName & "].[PhieuNhap$]"


End Sub

ps: Tôi khai báo không tường minh nhé.
Nhấp chuột vào đây để mở rộng...

Vậy cách này và cách dùng vòng lặp For thì cách nào nhanh hơn với dữ liệu khoảng vài chục dòng hả Anh.
 
Upvote 0
Em cảm ơn anh Hai Lúa đã giúp, Nhân tiện nhờ anh xem Giúp đoạn code nằm ngoài vấn đề ADO dưới đây, em sử dụng hàm MyFilter2DArray của thầy siwtom nhưng cứ bị báo lỗi ngay dòng đỏ. Em có gửi file kèm theo.Mong anh xem giúp.
p/s: Dưới đây chỉ là một trích đoạn từ code, anh Hai Lúa xem file giúp em nhé.
Mã: 
Sub LOC()
On Error Resume Next
Dim ArrCrit
Dim i, j As Long
Dim sArr(1 To 8, 1 To 2)
Dim tmp As Long
    
    sArr(1, 2) = 1
    sArr(2, 2) = 2
    sArr(3, 2) = 4
    sArr(4, 2) = 6
    sArr(5, 2) = 7
    sArr(6, 2) = 8
    sArr(7, 2) = 9
    sArr(8, 2) = 11
    
    For i = 1 To 8
        If Controls("textbox" & i) <> vbNullString Then
            sArr(i, 1) = sArr(i, 1) + i
            tmp = tmp + 1
        End If
    Next
    
    ReDim ArrCrit(1 To 2, 1 To tmp)
    
    j = 1
    
    For i = 1 To 8
    
        If sArr(i, 1) <> vbNullString Then
            
            ArrCrit(1, j) = sArr(i, 2)
            ArrCrit(2, j) = "*" & Controls("textbox" & i) & "*"
            
            If j = tmp Then
                Exit For
                
            Else
                j = j + 1
            End If
            
        End If
        
    Next
    
[COLOR=#ff0000]    tmpArr = MyFilter2DArray(DSPTArray, ArrCrit(), False, True)[/COLOR]
    
For i = 1 To UBound(ArrCrit, 2)
MsgBox ArrCrit(1, i)
MsgBox ArrCrit(2, i)
Next
 

File đính kèm

  • BH.rar
    110.2 KB · Đọc: 8
Upvote 0
Xin phép reup để chờ Anh Nghĩa và Anh Hai Lúa vào giúp.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

L
[xin nhờ giúp đỡ] hàm trích xuất ra dữ liệu thỏa mã điều kiện và ghi vào một ô
Trả lời
10
Đọc
387
cantl
C
LuuAnh980
Công thức lọc không trùng đơn hàng.
2
Trả lời
20
Đọc
271
VetMini
V
C
Hàm Textjoin nối chuỗi có định dạng ngày tháng
Trả lời
12
Đọc
468
cantl
C
V
Giúp công thức cộng tổng cột SỐ lượng theo cột STT nếu trùng lấy dòng nằm trên
Trả lời
16
Đọc
625
cantl
C
NgocNguyenBao
Không sử dụng được hàm Uniques Excel 2016
Trả lời
2
Đọc
43
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom