Xin nhờ xem giúp code về ADO (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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

Sắp xếp theo thời gian sắp xếp theo bầu chọn
ngothanhluan đã viết:
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
Nhấp chuột vào đây để mở rộng...

Có 2 vấn đề cần sửa trong bài của bạn:

Thứ nhất, tên file không đúng: HANG HOA chứ không phải là TONG

Thứ hai, HDR=Yes chứ không phải HDR=No

Code sửa lại như sau:

Mã: 
Sub update()
    Dim cnn As ADODB.Connection
    Dim FileFullName As String
    Set cnn = New ADODB.Connection
    FileFullName = Application.ThisWorkbook.Path & "\HANG HOA.xlsm"
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
        .Execute "UPDATE DS_HH SET TEN_SP='ALO123' WHERE MA_SP=10003;"
        MsgBox .State
    End With
End Sub
 
Upvote 0
Anh Nghĩa cho em hỏi, em muốn đưa một recordset vào trong 1 combobox hoặc một Arr để tiện sử dụng thì phải làm thế nào ạ.
 
Upvote 0
Upvote 0
Em dùng getrows() thi nó báo lỗi type miss match ngay dòng tô đỏ, còn nếu bỏ dòng đó đi thì dữ liệu combobox lại xuất hiện theo hàng ngang. Mong anh giải đáp giúp.
Mã: 
Private Sub UserForm_Activate()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim rcd As ADODB.Recordset
    Dim FileFullName As String
    
    Set cnn = New ADODB.Connection
    Set rcd = New ADODB.Recordset
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
    End With
    Set rcd = cnn.Execute("SELECT * FROM DS_HH")
    arr = rcd.GetRows()
    With ComboBox1
        .Clear
        .List = arr
       [COLOR=#ff0000] .List = Application.Transpose(arr)[/COLOR]
    End With
    


    Set rcd = Nothing
    cnn.Close


End Sub
 
Upvote 0
ngothanhluan đã viết:
Em dùng getrows() thi nó báo lỗi type miss match ngay dòng tô đỏ, còn nếu bỏ dòng đó đi thì dữ liệu combobox lại xuất hiện theo hàng ngang. Mong anh giải đáp giúp.
Mã: 
Private Sub UserForm_Activate()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim rcd As ADODB.Recordset
    Dim FileFullName As String
    
    Set cnn = New ADODB.Connection
    Set rcd = New ADODB.Recordset
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
    End With
    Set rcd = cnn.Execute("SELECT * FROM DS_HH")
  [B][COLOR=#ff0000]  arr = rcd.GetRows()
    With ComboBox1
        .Clear
        .List = arr
        .List = Application.Transpose(arr)
    End With[/COLOR][/B]
    


    Set rcd = Nothing
    cnn.Close


End Sub
Nhấp chuột vào đây để mở rộng...
Thử thay chổ màu đỏ như sau:

ComboBox1.Column = rcd.GetRows
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Dạ cảm ơn Anh, cho em hỏi với trường hợp muốn sắp xếp lại giá trị trong mảng thì phải làm như thế nào. Mong anh giúp.
 
Upvote 0
ngothanhluan đã viết:
Em dùng getrows() thi nó báo lỗi type miss match ngay dòng tô đỏ, còn nếu bỏ dòng đó đi thì dữ liệu combobox lại xuất hiện theo hàng ngang. Mong anh giải đáp giúp.
Mã: 
Private Sub UserForm_Activate()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim rcd As ADODB.Recordset
    Dim FileFullName As String
    
    Set cnn = New ADODB.Connection
    Set rcd = New ADODB.Recordset
    
    FileFullName = Application.ThisWorkbook.Path & "\TONG.xlsm"
    
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
        .Open
    End With
    Set rcd = cnn.Execute("SELECT * FROM DS_HH")
    arr = rcd.GetRows()
    With ComboBox1
        .Clear
        .List = arr
       [COLOR=#ff0000] .List = Application.Transpose(arr)[/COLOR]
    End With
    


    Set rcd = Nothing
    cnn.Close


End Sub
Nhấp chuột vào đây để mở rộng...
Trùi ui, ai mà làm như thế!

Mã: 
Sub test()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim FileFullName As String, sQL As String
    Dim rcd As ADODB.Recordset
    Set cnn = New ADODB.Connection
    Set rcd = CreateObject("ADODB.recordset")
    FileFullName = Application.ThisWorkbook.Path & "\HangHoa.xlsm"
    sQL = "SELECT * FROM DS_HH"
    cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
    cnn.Open
    rcd.Open sQL, cnn
    arr = rcd.GetRows()
    arr = WorksheetFunction.Transpose(arr)
    Sheet1.ComboBox1.List = arr
    cnn.Close
End Sub
 
Upvote 0
Upvote 0
Upvote 0
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Trùi ui, ai mà làm như thế!

Mã: 
Sub test()
    Dim arr
    Dim cnn As ADODB.Connection
    Dim FileFullName As String, sQL As String
    Dim rcd As ADODB.Recordset
    Set cnn = New ADODB.Connection
    Set rcd = CreateObject("ADODB.recordset")
    FileFullName = Application.ThisWorkbook.Path & "\HangHoa.xlsm"
    sQL = "SELECT * FROM DS_HH"
    cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & FileFullName _
                & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
    cnn.Open
    rcd.Open sQL, cnn
    arr = rcd.GetRows()
    arr = WorksheetFunction.Transpose(arr)
    Sheet1.ComboBox1.List = arr
    cnn.Close
End Sub
Nhấp chuột vào đây để mở rộng...

Nếu dùng transpose đối với dữ liệu lớn dễ bị vỡ. Vậy thì ngoài transpose và cách qua trung gian của anh Hai Lúa ra thì còn cách nào khác để gán cho mảng nữa không ạ. Mong anh giải đáp.
 
Lần chỉnh sửa cuối:
Upvote 0
ngothanhluan đã viết:
Em có đọc mấy bài trong diễn đàn, sao thấy có ý kiến cho rằng dùng transpose đối với dữ liệu lớn dễ bị vỡ. Vậy thì ngoài transpose thì còn cách nào khác không ạ. Mong anh giải đáp.
Nhấp chuột vào đây để mở rộng...
Đó, như tôi đã nói, dùng ComboBox hay ListBox làm trung gian, hoặc dùng hàm tự tạo (nhớ rằng Hai Lúa Miền Tây có post hàm này ở đâu đó).
 
Upvote 0
Chân thành Cảm ơn Anh Hai Lúa và Anh Nghĩa đã giúp ạ.
 
Upvote 0
ngothanhluan đã viết:
Chân thành Cảm ơn Anh Hai Lúa và Anh Nghĩa đã giúp ạ.
Nhấp chuột vào đây để mở rộng...
Hàm đó ở đây:

Mã: 
Function TransArr(sArr As Variant) As Variant
    Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
    tmpX = UBound(sArr, 2):    tmpY = UBound(sArr, 1)
    ReDim tmpArr(tmpX, tmpY)
    For cllX = 0 To tmpX
        For cllY = 0 To tmpY
            tmpArr(cllX, cllY) = sArr(cllY, cllX)
        Next cllY
    Next cllX
    TransArr = tmpArr
End Function

Tham khảo thêm tại đây:

http://www.giaiphapexcel.com/forum/showthread.php?75143-Bài-tập-về-ADO-căn-bản&p=463059#post463059
 
Upvote 0
Anh Nghĩa cho hỏi, em dùng liên kết đến file acces thì nó lại báo lỗi Operation must use an updatetable query.Không biết câu lệnh bị sai chỗ nào mong anh giải đáp giúp. Em có gửi file đính kèm lên.
Mã: 
Sub KET_NOI_DU_LIEU_ACC()
Dim sPath As String
Dim cnnacc As New ADODB.Connection


      sPath = Application.ThisWorkbook.Path & "\TONG.accdb"
    
    With cnnacc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=NO"";"
        .Open
        
    End With
    Set rcd = cnnacc.Execute("SELECT MAX(MA_KH) FROM DS_KH")
    maxmaKH = rcd.GetString()


    cnnacc.Execute ("INSERT INTO DS_KH(MA_KH) VALUES('" & maxmaKH + 1 & "')")
    
    cnnacc.Close
    
End Sub
 

File đính kèm

Upvote 0
ngothanhluan đã viết:
Anh Nghĩa cho hỏi, em dùng liên kết đến file acces thì nó lại báo lỗi Operation must use an updatetable query.Không biết câu lệnh bị sai chỗ nào mong anh giải đáp giúp. Em có gửi file đính kèm lên.
Mã: 
Sub KET_NOI_DU_LIEU_ACC()
Dim sPath As String
Dim cnnacc As New ADODB.Connection


      sPath = Application.ThisWorkbook.Path & "\TONG.accdb"
    
    With cnnacc
    
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";[B][COLOR=#ff0000]HDR=NO[/COLOR][/B]"";"
        .Open
        
    End With
    Set rcd = cnnacc.Execute("SELECT MAX(MA_KH) FROM DS_KH")
    maxmaKH = rcd.GetString()


    cnnacc.Execute ("INSERT INTO DS_KH(MA_KH) VALUES('" & maxmaKH + 1 & "')")
    
    cnnacc.Close
    
End Sub
Nhấp chuột vào đây để mở rộng...

Làm ơn cho xin chữ này đi: HDR=YES

Hôm trước đã đề cập rồi! Có tiêu đề cột thì Yes, Không thì No. Vậy đi nha.
 
Upvote 0
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
 
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

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

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

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

Upvote 0
ngothanhluan đã viết:
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
Nhấp chuột vào đây để mở rộng...
Nhà cúp điện, máy hết pin, tôi chỉ có thể dùng điện thoại để trả lời bạn.

Nhìn chung thấy code tương đối hoàn chỉnh, riêng biến tmpArr chưa thấy khai báo. Đặc biệt, biến mảng DSPTArray tôi không biết nguồn dữ liệu lấy ở đâu, như thế nào.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Nhà cúp điện, máy hết pin, tôi chỉ có thể dùng điện thoại để trả lời bạn.

Nhìn chung thấy code tương đối hoàn chỉnh, riêng biến tmpArr chưa thấy khai báo. Đặc biệt, biến mảng DSPTArray tôi không biết nguồn dữ liệu lấy ở đâu, như thế nào.
Nhấp chuột vào đây để mở rộng...
Dạ em có ghi chú lại là đoạn code trên chỉ là phần nằm trong form, phần khai báo em khai báo đầu chương trình rồi. Anh Nghĩa xem file giúp em thử xem sai chỗ nào. Trong khi em dùng msgbox để kiểm tra phần tử cũng như số cột và dòng của mảng thì vẫn thấy bình thường.
 
Upvote 0
ngothanhluan đã viết:
Dạ em có ghi chú lại là đoạn code trên chỉ là phần nằm trong form, phần khai báo em khai báo đầu chương trình rồi. Anh Nghĩa xem file giúp em thử xem sai chỗ nào. Trong khi em dùng msgbox để kiểm tra phần tử cũng như số cột và dòng của mảng thì vẫn thấy bình thường.
Nhấp chuột vào đây để mở rộng...

Tầm 13h nhà đèn mới cho ký điện, nếu chừng đó mà chưa ai giúp thì tôi sẽ kiểm tra file bạn.
 
Upvote 0
ngothanhluan đã viết:
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
Nhấp chuột vào đây để mở rộng...
Với cái sub trên, bạn lọc cái gì thế? Tôi chỉ hỏi ở TextBox1 thôi, lọc cái gì?
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Với cái sub trên, bạn lọc cái gì thế? Tôi chỉ hỏi ở TextBox1 thôi, lọc cái gì?
Nhấp chuột vào đây để mở rộng...
Dạ Textbox1 lọc mã phiếu thu, tương tự như các Textbox khác đó Anh. Tại vì theo như hàm của thầy siwtom nếu dùng em phải khai báo hết 8 cột trong arrcrit và cái này làm chậm code nên em mới dùng sub trên để khi người dùng lọc ở textbox nào thì sẽ tự tạo arrcrit.
 
Lần chỉnh sửa cuối:
Upvote 0
ngothanhluan đã viết:
Dạ Textbox1 lọc mã phiếu thu, tương tự như các Textbox khác đó Anh. Tại vì theo như hàm của thầy siwtom nếu dùng em phải khai báo hết 8 cột trong arrcrit và cái này làm chậm code nên em mới dùng sub trên để khi người dùng lọc ở textbox nào thì sẽ tự tạo arrcrit.
Nhấp chuột vào đây để mở rộng...
Tôi không hiểu sao, trong listbox bạn lại set 12 cột, và trong đó có ẩn 2 cột
Rồi mấy cái cột bạn ẩn đó có tác dụng gì không vì trong code ADO bạn lại Select chúng ra?
Chính vì cái này tôi bị khựng không biết tại sao vì lúc đầu cứ tưởng chúng là liên tục theo chỉ số tăng dần của ListBox.

Và thêm nữa, nếu lọc ở 1 textbox khi ra kết quả thì sao? Có qua textbox khác lọc lại theo kết quả vừa có hay không hay vẫn lọc theo nguồn mảng ban đầu?
 
Upvote 0
ngothanhluan đã viết:
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
Nhấp chuột vào đây để mở rộng...
Thường nếu làm việc trên form thì nên tạo hẳn 1 sub kết nối riêng, không cần thiết phải thực hiện 1 lệnh rồi mở kết nối lại từ đầu rồi đóng kết nối khi xong lệnh đó.
Trường hợp của bạn có thể thực hiện lọc luôn trong đoạn query. Cái code lọc trên không phải tôi viết và tôi cũng không nghiên cứu nó. Nếu bạn theo hướng theo code trên thì tôi chào thua, còn nếu muốn theo cách tôi gợi ý thì tiếp tục.
Điều đáng lưu ý với bạn là lọc ngày không đơn giản đâu nhé, phải định dạng theo chuẩn trước khi lọc.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Tôi không hiểu sao, trong listbox bạn lại set 12 cột, và trong đó có ẩn 2 cột
Rồi mấy cái cột bạn ẩn đó có tác dụng gì không vì trong code ADO bạn lại Select chúng ra?
Chính vì cái này tôi bị khựng không biết tại sao vì lúc đầu cứ tưởng chúng là liên tục theo chỉ số tăng dần của ListBox.

Và thêm nữa, nếu lọc ở 1 textbox khi ra kết quả thì sao? Có qua textbox khác lọc lại theo kết quả vừa có hay không hay vẫn lọc theo nguồn mảng ban đầu?
Nhấp chuột vào đây để mở rộng...
Dạ những cột đó em thấy không cần thiết hiển thị nên mới ẩn đi để giảm bớt độ rộng cho form và rối mắt người dùng.
Mấy cột ẩn đó vẫn có tác dụng khi em lập phiếu thu ạ.
Dạ khi lọc ở các Textbox thì theo như sub em viết thì nếu mỗi lần ấn phím ENTER thì có n Textbox khác rỗng thì sẽ tạo ra ArrCrit(1 to 2, 1 to n) đề dùng hàm MyFilter2DArray để lọc và các điều kiện đều nối nhau bằng AND ạ.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Thường nếu làm việc trên form thì nên tạo hẳn 1 sub kết nối riêng, không cần thiết phải thực hiện 1 lệnh rồi mở kết nối lại từ đầu rồi đóng kết nối khi xong lệnh đó.
Trường hợp của bạn có thể thực hiện lọc luôn trong đoạn query. Cái code lọc trên không phải tôi viết và tôi cũng không nghiên cứu nó. Nếu bạn theo hướng theo code trên thì tôi chào thua, còn nếu muốn theo cách tôi gợi ý thì tiếp tục.
Điều đáng lưu ý với bạn là lọc ngày không đơn giản đâu nhé, phải định dạng theo chuẩn trước khi lọc.
Nhấp chuột vào đây để mở rộng...
Mong Anh Hai Lúa gợi ý giúp em ạ. Em đang làm phần mềm bán hàng cho Công Ty em bằng excel kết hợp với A-Tool của Anh Nguyễn Duy Tuân nên nếu được, khi xong anh Hai Lúa với Anh Nghĩa có thể xem và góp ý giúp được không ạ.
 
Upvote 0
ngothanhluan đã viết:
Dạ những cột đó em thấy không cần thiết hiển thị nên mới ẩn đi để giảm bớt độ rộng cho form và rối mắt người dùng.
Nhấp chuột vào đây để mở rộng...
Sao trong đoạn Query bạn không bỏ nó ra luôn cho nó nhẹ, chứ ẩn như bạn thì cũng đã load dữ liệu rồi.
ngothanhluan đã viết:
Mong Anh Hai Lúa gợi ý giúp em ạ.
Nhấp chuột vào đây để mở rộng...
Thì tôi đã gợi ý cho bạn rồi đó, là không dùng cái hàm filter mà chỉ dùng where trong đoạn truy vấn mà thôi.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Sao trong đoạn Query bạn không bỏ nó ra luôn cho nó nhẹ, chứ ẩn như bạn thì cũng đã load dữ liệu rồi.

Thì tôi đã gợi ý cho bạn rồi đó, là không dùng cái hàm filter mà chỉ dùng where trong đoạn truy vấn mà thôi.
Nhấp chuột vào đây để mở rộng...
Dạ em vẫn còn dùng 2 cột ẩn đó khi dùng đến Form lập phiếu thu nữa Anh Hai Lúa.
 
Upvote 0
Dạ cụ thể là Phần mềm em viết được dùng cho khoảng 5 chi nhánh. Mỗi chi nhánh sẽ có 1 file excel và access như vậy để chạy. Cộng thêm một file TONG chứa dữ liệu cần truy vấn chung như Danh sách Khách hàng... Tất cả được để trong một máy dùng A-Tool để chạy làm máy chủ ạ. Em không biết là nếu dùng ADO nhiều thì khi có nhiều máy cùng kết nối ADO với file thì không biết có vấn để gì không ạ.
 
Upvote 0
ngothanhluan đã viết:
Dạ những cột đó em thấy không cần thiết hiển thị nên mới ẩn đi để giảm bớt độ rộng cho form và rối mắt người dùng.
Mấy cột ẩn đó vẫn có tác dụng khi em lập phiếu thu ạ.
Dạ khi lọc ở các Textbox thì theo như sub em viết thì nếu mỗi lần ấn phím ENTER thì có n Textbox khác rỗng thì sẽ tạo ra ArrCrit(1 to 2, 1 to n) đề dùng hàm MyFilter2DArray để lọc và các điều kiện đều nối nhau bằng AND ạ.
Nhấp chuột vào đây để mở rộng...
Với n của bạn sẽ là mấy? Ở đây Hàm đó tác giả chỉ có thực hiện lọc trên 2 hàng và 2 cột điều kiện tương ứng thôi.

Sao không làm theo hướng của Hai Lúa? Mở kết nối, không khóa, rồi slect theo điều kiện thôi? Sau đó xuất giá trị đó ra ListBox? Thoát form hãy đóng kết nối.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Với n của bạn sẽ là mấy? Ở đây Hàm đó tác giả chỉ có thực hiện lọc trên 2 hàng và 2 cột điều kiện tương ứng thôi.

Sao không làm theo hướng của Hai Lúa? Mở kết nối, không khóa, rồi slect theo điều kiện thôi? Sau đó xuất giá trị đó ra ListBox? Thoát form hãy đóng kết nối.
Nhấp chuột vào đây để mở rộng...
Đúng là thế, mình không nói mình là dân chuyên nghiệp nhưng thường các phần mềm lớn người ta cũng làm thế.

@ngothanhluan:
Nếu CSDL là access thì tôi cũng đã từng làm có thể gặp lỗi khi 2 người cùng truy cập vào 1 dòng dữ liệu.
Nếu CSDL lớn sao không chọn giải pháp là SQLServer hay là MySQL?
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Với n của bạn sẽ là mấy? Ở đây Hàm đó tác giả chỉ có thực hiện lọc trên 2 hàng và 2 cột điều kiện tương ứng thôi.

Sao không làm theo hướng của Hai Lúa? Mở kết nối, không khóa, rồi slect theo điều kiện thôi? Sau đó xuất giá trị đó ra ListBox? Thoát form hãy đóng kết nối.
Nhấp chuột vào đây để mở rộng...
Dạ hàm MyFilter2DArray được phép lọc đến k cột lận Anh Nghĩa ơi.
Anh Hai Lúa với Anh Nghĩa xem thử ý kiến dưới của em có được không, em chỉ băn khoăn vấn đề dưới thôi. Chứ nếu được thì em sẽ sửa hết mọi hàm filter trong phần mềm thành dùng ADO hết cho nhanh ạ.

Dạ cụ thể là Phần mềm em viết được dùng cho khoảng 5 chi nhánh. Mỗi chi nhánh sẽ có 1 file excel và access như vậy để chạy. Cộng thêm một file TONG chứa dữ liệu cần truy vấn chung như Danh sách Khách hàng... Tất cả được để trong một máy dùng A-Tool để chạy làm máy chủ ạ. Em không biết là nếu dùng ADO nhiều thì khi có nhiều máy cùng kết nối ADO với file thì không biết có vấn để gì không ạ
 
Lần chỉnh sửa cuối:
Upvote 0
ngothanhluan đã viết:
Em không biết là nếu dùng ADO nhiều thì khi có nhiều máy cùng kết nối ADO với file thì không biết có vấn để gì không ạ
Nhấp chuột vào đây để mở rộng...
File mà bạn đang hỏi là kết nối đến file nào? File Access? Nếu thế thì tôi đã trả lời ờ bài #54
​
rồi. Thêm nữa là tôi cũng đã từng làm file access để dùng chứa dữ liệu 20 máy kết nối vào vẫn ok. Tuy nhiên phải share full folder, rất nguy hiểm và liên quan đến vấn đề bảo mật. Ai cũng có thể truy cập và nếu ai đó phá thì "bộp" 1 phát là xem như xong.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
File mà bạn đang hỏi là kết nối đến file nào? File Access? Nếu thế thì tôi đã trả lời ờ bài #54 rồi. Thêm nữa là tôi cũng đã từng làm file access để dùng chứa dữ liệu 20 máy kết nối vào vẫn ok. Tuy nhiên phải share full folder, rất nguy hiểm và liên quan đến vấn đề bảo mật. Ai cũng có thể truy cập và nếu ai đó phá thì "bộp" 1 phát là xem như xong.
Nhấp chuột vào đây để mở rộng...
Em xin gửi file lên để Anh Hai Lúa và Anh Nghĩa xem thử ạ. Một số form em chưa hoàn thành.
Người dùng chỉ trích xuất dữ liệu vào thao tác trên form thôi ạ. Còn các vấn đề phân quyền đã có A-Tool xử lý rồi ạ.
Mong 2 anh xem và góp ý giúp em để em hoàn thành sớm ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Đúng là thế, mình không nói mình là dân chuyên nghiệp nhưng thường các phần mềm lớn người ta cũng làm thế.

@ngothanhluan:
Nếu CSDL là access thì tôi cũng đã từng làm có thể gặp lỗi khi 2 người cùng truy cập vào 1 dòng dữ liệu.
Nếu CSDL lớn sao không chọn giải pháp là SQLServer hay là MySQL?
Nhấp chuột vào đây để mở rộng...
Hix em mới học VBA được hơn tháng mà anh bảo dùng tới SQLServer thì chịu rồi. Hiện chỉ làm tạm bằng Access thôi, rồi em phải học thêm một thời gian nữa mới chuyển CSDL qua SQLServer được.
 
Upvote 0
ngothanhluan đã viết:
Dạ hàm MyFilter2DArray được phép lọc đến k cột lận Anh Nghĩa ơi.
Nhấp chuột vào đây để mở rộng...
Hình như bạn chưa hiểu ý tôi nói, ở đây chỉ lọc 2 điều kiện.

Tôi nói rõ hơn cho bạn hiểu nhé,

Tôi lọc tại cột 1, của textbox1 kết quả hiện lên listbox

Tôi qua textbox2, tôi lại đặt điều kiện.

Có 2 trường hợp xảy ra:

1) Chỉ lọc trên nguồn dữ liệu cũ (DSPTArray), trường hợp này quá dễ rồi

2) Lọc tiếp cái kết quả đã lọc ở textbox1, cái này chua đây, bởi thực hiện toàn bộ trên 8 cái textbox thì sao?
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Hình như bạn chưa hiểu ý tôi nói, ở đây chỉ lọc 2 điều kiện.

Tôi nói rõ hơn cho bạn hiểu nhé,

Tôi lọc tại cột 1, của textbox1 kết quả hiện lên listbox

Tôi qua textbox2, tôi lại đặt điều kiện.

Có 2 trường hợp xảy ra:

1) Chỉ lọc trên nguồn dữ liệu cũ (DSPTArray), trường hợp này quá dễ rồi

2) Lọc tiếp cái kết quả đã lọc ở textbox1, cái này chua đây, bởi thực hiện toàn bộ trên 8 cái textbox thì sao?
Nhấp chuột vào đây để mở rộng...
Cái của em là trường hợp 1 có anh Nghĩa ơi, Vì mỗi lần ENTER ở một textbox thì nó phải chạy lại trên dữ liệu nguồn và với điều kiện là 8 cái textbox trên. Bởi vậy nên em mới làm cái sub đó để loại bớt những textbox rỗng đó anh. Nhưng không hiểu sao nó lại báo lỗi ngay cái Arrcrit() mong anh giải đáp giúp.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Đúng là thế, mình không nói mình là dân chuyên nghiệp nhưng thường các phần mềm lớn người ta cũng làm thế.

@ngothanhluan:
Nếu CSDL là access thì tôi cũng đã từng làm có thể gặp lỗi khi 2 người cùng truy cập vào 1 dòng dữ liệu.
Nếu CSDL lớn sao không chọn giải pháp là SQLServer hay là MySQL?
Nhấp chuột vào đây để mở rộng...
Anh Hai Lúa cho em hỏi thêm là khi 2 người cùng ghi dữ liệu vào file Access cùng 1 lúc thì mình có thể bẫy lỗi được không ạ. Ví dụ như msgbox "Qua trinh ghi du lieu gap loi, Vui long thuc hien lai!". Mong anh giải đáp giúp em.
 
Upvote 0
ngothanhluan đã viết:
Cái của em là trường hợp 1 có anh Nghĩa ơi, Vì mỗi lần ENTER ở một textbox thì nó phải chạy lại trên dữ liệu nguồn và với điều kiện là 8 cái textbox trên. Bởi vậy nên em mới làm cái sub đó để loại bớt những textbox rỗng đó anh. Nhưng không hiểu sao nó lại báo lỗi ngay cái Arrcrit() mong anh giải đáp giúp.
Nhấp chuột vào đây để mở rộng...
Bây giờ tôi làm luôn cái trường hợp 2 cho bạn luôn đây!

Nếu muốn lọc 1 cái thì đảm bảo mỗi cái textbox được lọc có giá trị, các textbox khác phải rỗng

Và nếu các textbox khác, kể cả 8 cái cùng có giá trị thì sẽ lọc theo kiểu AND, có nghĩa là lọc hết.

Tôi viết cho bạn cái Module riêng như sau:

Mã: 
Function ChuyenCotThanhHang(ByVal sArray As Variant) As Variant
    ''Ham ChuyenCotThanhHang nhan mang co can nhu the nao thi
    ''se tra lai mang 2 chieu co can nhu the ay.
    ''sArray: Mang xuat ra tu ADO: GetRows()
    ''Mang nay co can hang bang 0, can cot bang 0
    
    Dim tmpArr As Variant
    Dim i As Long, j As Long
    
    Dim lCol As Long, lRow As Long
    Dim uCol As Long, uRow As Long
    
    lRow = LBound(sArray, 1)
    lCol = LBound(sArray, 2)
    
    uRow = UBound(sArray, 1)
    uCol = UBound(sArray, 2)
    
    ReDim tmpArr(lCol To uCol, lRow To uRow)
    
    For i = lCol To uCol
        For j = lRow To uRow
            tmpArr(i, j) = sArray(j, i)
        Next
    Next
    
    ChuyenCotThanhHang = tmpArr
    
End Function




Function LocMang2Chieu(ByVal MangNguon2Chieu, ByVal SoThuTuCot As Byte, ByVal DieuKien As String) As Variant
    ''MangNguon2Chieu(): Bat buoc la mang 2 chieu, hoac can dau la 0 (dang MangNguon2Chieu(0 to m, 0 to n)
                        ''Hoac can dau la 1 (dang MangNguon2Chieu(1 to m, 1 to n)
    ''SoThuTuCot: Neu mang co can dau cua cot la 0 thi cot dau tien se la 0, nguoc lai se chinh la 1.
    
    Dim GetRow(), tmpArr()
    Dim lCol As Long, lRow As Long
    Dim uCol As Long, uRow As Long
    Dim c As Long, n As Long, r As Long
    
    lRow = LBound(MangNguon2Chieu, 1)
    lCol = LBound(MangNguon2Chieu, 2)


    uRow = UBound(MangNguon2Chieu, 1)
    uCol = UBound(MangNguon2Chieu, 2)
    
    For r = lRow To uRow
        If UCase(MangNguon2Chieu(r, SoThuTuCot)) Like "*" & DieuKien & "*" Then
            n = n + 1
            ReDim Preserve GetRow(1 To n)
            GetRow(n) = r
        End If
    Next
    
    If n Then
        Dim IsCheck As Boolean
        IsCheck = (lRow = 0)
        n = n + IsCheck
        ReDim tmpArr(lRow To n, lCol To uCol)
        For r = lRow To n
            For c = lCol To uCol
                tmpArr(r, c) = MangNguon2Chieu(GetRow(r - IsCheck), c)
            Next
        Next
        LocMang2Chieu = tmpArr
    End If
End Function

Và code trên Form tôi sửa lại như sau:

Mã: 
Private Sub UserForm_Initialize()
    tmpStr = Month(Date) & "/" & Year(Date)
    Call DS_PT
End Sub


Private Sub DS_PT() 'lay danh sach phieu thu tu tbl PHIEU_THU
Dim sPath As String
Dim cnnAccS As ADODB.Connection
Dim rcdTEMP As ADODB.Recordset
    Set cnnAccS = New ADODB.Connection
    With cnnAccS
    sPath = Application.ThisWorkbook.Path & "\" & sName & ".accdb"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                & "Data Source=" & sPath _
                & ";Extended Properties="";HDR=Yes"";"
        .Open
    End With
    Set rcdTEMP = New ADODB.Recordset
    Set rcdTEMP = cnnAccS.Execute("SELECT MA_PHIEU,NGAY_THANG,MA_KH,TEN_KH,FORMAT(DA_THU,'#,###')," & _
                                        "CHUNG_TU_GOC,NHOM_SP,HINH_THUC,NGAN_HANG," & _
                                        "GHI_CHU,TEN_NVKD,MA_NVKD " & _
                                    "FROM PHIEU_THU WHERE NGAY_THANG LIKE '%" & tmpStr & "%'")
[COLOR=#ff0000][B]    DSPTArray = ChuyenCotThanhHang(rcdTEMP.GetRows())[/B][/COLOR]
    ListBox1.List() = DSPTArray
    Set rcdTEMP = Nothing
    cnnAccS.Close
End Sub

Và thủ tục chính trong form đó như sau:

Sự kiện của TextBox:

Mã: 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Call LocKieuMoi
    If priIsFocus Then
        Cancel = True
    End If
End Sub

Thủ tục chạy:

Mã: 
Sub LocKieuMoi()
priIsFocus = False
    Dim i As Byte, n As Byte
    Dim ArrCol(), tmpArr
    Dim ArrSub(0 To 1)
    Dim ArrSum()
    ArrCol = Array(0, 1, 3, 5, 6, 7, 8, 10)
    For i = 1 To 8
        If Trim(Me("TextBox" & i).Text) > "" Then
            n = n + 1
            ArrSub(0) = ArrCol(i - 1)
            ArrSub(1) = UCase(Trim(Me("TextBox" & i).Text))
            ReDim Preserve ArrSum(1 To n)
            ArrSum(n) = ArrSub
        End If
    Next
    If n Then
        For i = 1 To n
            Dim ArrTmp As Variant
            If i = 1 Then
                ArrTmp = LocMang2Chieu(DSPTArray, ArrSum(1)(0), ArrSum(1)(1))
                If IsArray(ArrTmp) Then
                    tmpArr = ArrTmp
                Else
                    GoTo ExitSub
                End If
            Else
                ArrTmp = LocMang2Chieu(tmpArr, ArrSum(i)(0), ArrSum(i)(1))
                If IsArray(ArrTmp) Then
                    tmpArr = ArrTmp
                Else
                    GoTo ExitSub
                End If
            End If
        Next
        ListBox1.List = tmpArr
    Else
        If UBound(DSPTArray) > ListBox1.ListCount - 1 Then
            ListBox1.List = DSPTArray
        End If
    End If
    Exit Sub
ExitSub:
MsgBox "Mot trong cac dieu kien cua ban khong hop ly!"
priIsFocus = True
End Sub

Tôi cũng thêm 1 Label, Khi hủy bỏ việc lọc ListBox trả lại trạng thái ban đầu:

Mã: 
Private Sub lblClearFilter_Click()
    If UBound(DSPTArray) > ListBox1.ListCount - 1 Then
        ListBox1.List = DSPTArray
    End If
End Sub
 

File đính kèm

Upvote 0
ngothanhluan đã viết:
Dạ Em cảm ơn Anh Nghĩa nhiều ạ.
Nhấp chuột vào đây để mở rộng...
Bổ sung cái Label Hủy Filter lại nha bạn:

Mã: 
Private Sub lblClearFilter_Click()
    If UBound(DSPTArray) > ListBox1.ListCount - 1 Then
        Dim i As Byte
        For i = 1 To 8
            Me("TextBox" & i).Text = ""
        Next
        ListBox1.List = DSPTArray
    End If
End Sub
 
Upvote 0
Anh Nghĩa và Anh Hai Lúa cho em hỏi, dùng ADO kết nối tới MYSQL thông qua localhost chạy bằng xampp hoặc kết nối tới MYSQL trên hosting công ty thuê được không ạ. Và Câu lệnh kết nối phải như thế nào, mong hai anh giúp em.
 
Upvote 0
ngothanhluan đã viết:
Anh Nghĩa và Anh Hai Lúa cho em hỏi, dùng ADO kết nối tới MYSQL thông qua localhost chạy bằng xampp hoặc kết nối tới MYSQL trên hosting công ty thuê được không ạ. Và Câu lệnh kết nối phải như thế nào, mong hai anh giúp em.
Nhấp chuột vào đây để mở rộng...
Dùng ADO có thể kết nối tới MySQL trong mạng Lan cũng như qua Internet.

Mã: 
[COLOR=#141823][FONT=helvetica]Sub Query_MySQL()
[/FONT][/COLOR][COLOR=#141823][FONT=helvetica]Dim cn As Object, rst As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open "Driver={MySQL ODBC 5.3 ANSI Driver};Server=[COLOR=#ff0000][B]ServerNameOrHostName[/B][/COLOR];Database=[COLOR=#0000ff]DatabaseName[/COLOR];" & _
"User=[COLOR=#0000ff]YourUserName[/COLOR];Password=[COLOR=#0000ff]YourPass[/COLOR];Option=3;"
Set rst = cn.Execute("SELECT * FROM YOURTABLE")
Range("A2").CopyFromRecordset rst[/FONT][/COLOR]
[COLOR=#141823][FONT=helvetica]End Sub[/FONT][/COLOR]

1. Đối với mạng lan (localhost): Chổ màu đỏ bạn thay vào địa chỉ địa chỉ IP của máy cài MySQL. Lưu ý là bạn phải cấu hình cho phép kết nối từ ngoài vào. Sao không cài hẳn cái MySQL vào luôn mà phải qua xampp, không khéo coi chừng bị virus nhé.
2. Kết nối qua mạng Internet thông qua hosting thì bạn nên kiểm tra xem cái gói thuê hosting đó có MySQL hay là không. Nếu có thì cung cấp vào những chổ tô đỏ và xanh ở trên là được.
 
Upvote 0
Anh Hai Lúa cho em hỏi em vào trang chủ MySQL thì thấy có nhiều cái quá không biết load cái nào, nào là MySQL on Windows, MySQL community Server..., Mong anh Hai Lúa hướng dẫn giúp ạ.
 
Upvote 0
Upvote 0
Anh Hai Lúa cho em hỏi, mấy cái provider dùng để kết nối trong excel mình lấy ở đâu ra ạ. Có trang nói rõ và liệt kê công dụng của từng cái được không anh. Em muốn tìm hiểu sâu hơn ạ. Mong anh giúp.
 
Upvote 0
Upvote 0
Em xin hỏi, file excel em đang xây dựng dùng để ghi, trích xuất dữ liệu trên host đang thuê thì tốc độ như thế nào và phụ thuộc vào những gì ạ.
 
Upvote 0
ngothanhluan đã viết:
Em xin hỏi, file excel em đang xây dựng dùng để ghi, trích xuất dữ liệu trên host đang thuê thì tốc độ như thế nào và phụ thuộc vào những gì ạ.
Nhấp chuột vào đây để mở rộng...
Dĩ nhiên là phụ thuộc vào tốc độ đường truyền + CSDL truy vấn là nhiều bản ghi hay ít, số lượng thành viên đăng nhập...
 
Upvote 0
Em xin hỏi một tí về Function trong SQL ạ, em có đoạn code sau để lấy STT max dùng để ghép chuỗi tạo mã đơn hàng nhưng nó cứ báo lỗi code 1054 unknow column idphieu_xuat in list field hoài. Mong anh xem thử ạ.
Mã: 
CREATE DEFINER=`root`@`localhost` FUNCTION `MAX_ID`(id varchar(45),tbl varchar(45)) RETURNS int(11)
BEGIN
declare idmax integer;
    set idmax=(select max(id) from tbl);
    return idmax=idmax+1;
END
sau đó em dùng lệnh như sau:
Mã: 
INSERT INTO phieu_xuat(idphieu_xuat) values(MAX_ID(idphieu_xuat,phieu_xuat))
em không biết bị lỗi chỗ nào mong anh Hai Lúa giúp.
Code trên em thực hiện trực tiếp trong MySQL luôn ạ.
 
Upvote 0
ngothanhluan đã viết:
Em xin hỏi, file excel em đang xây dựng dùng để ghi, trích xuất dữ liệu trên host đang thuê thì tốc độ như thế nào và phụ thuộc vào những gì ạ.
Nhấp chuột vào đây để mở rộng...

Nếu trên máy của bạn thì lần đầu tiên kết nói sẽ lâu, vì hệ thống phải giải quyết những thủ tục. Nhưng những lần kế tiếp sẽ nhanh hơn vì đường kết nối còn giứ đó. Hoặc nếu đường kết nối đã cắt thì hệ thống cũng đã biết và nhớ hầu hết điều kiện rồi.

Trên Server thuê thì rất phức tạp. Server có khả năng giữ hoặc nhớ đường kết nối, nhưng vì là server thuê cho nên phải tuỳ theo họ giành cho bạn những quyền lợi gì.
 
Upvote 0
VetMini đã viết:
Nếu trên máy của bạn thì lần đầu tiên kết nói sẽ lâu, vì hệ thống phải giải quyết những thủ tục. Nhưng những lần kế tiếp sẽ nhanh hơn vì đường kết nối còn giứ đó. Hoặc nếu đường kết nối đã cắt thì hệ thống cũng đã biết và nhớ hầu hết điều kiện rồi.

Trên Server thuê thì rất phức tạp. Server có khả năng giữ hoặc nhớ đường kết nối, nhưng vì là server thuê cho nên phải tuỳ theo họ giành cho bạn những quyền lợi gì.
Nhấp chuột vào đây để mở rộng...
Anh VetMiNi cho em hỏi, vậy giữa việc tính toán trên server rồi đưa xuống máy và việc đưa xuống máy tính toán rồi mới đưa lên server thì bên nào lợi hơn và lợi hơn về cái gì ạ. Cụ thể là đoạn code em lấy MAX_ID như bài #74 ạ. Nếu đưa xuống máy thì em phải lấy record tới 2 lần ạ.
 
Upvote 0
CSDL có cách bảo đảm nguyên vẹn transaction của nó (qua những lệnh như commit, rollback). Đưa xuống máy thì làm cách nào bạn bảo đảm?

Vả lại, CSDL luôn luôn có cách tối ưu hoá của nó. 99% trường hợp là cái nào nó tính được thì cứ để cho nó tính.

Một trong những trường hợp đặc thù mà bạn phải tải về, tính trên máy mình là trường hợp phải duyệt từng record. Nhất là nếu phải dùng con trỏ. Con trỏ trong CSDL LH chạy rất tốn kém.

Đó là nói chung thôi. Chứ cách sử lý còn tuỳ thuộc vào trường hợp nhiều người dùng, bạn có thể bị locked recrods, và cần phải sử lý snapshot.
 
Upvote 0
Hiện em thấy có chức năng lưu file ảnh bằng định dạng OLE Objects trong Access nên nảy ra ý tưởng lưu dữ liệu hình ảnh khách hàng lên file rồi dùng ADO lấy hình đưa lên form trong excel nhưng không biết làm sao. Mong Anh Hai Lúa đi ngang vào giúp đỡ.
 
Upvote 0
ngothanhluan đã viết:
Hiện em thấy có chức năng lưu file ảnh bằng định dạng OLE Objects trong Access nên nảy ra ý tưởng lưu dữ liệu hình ảnh khách hàng lên file rồi dùng ADO lấy hình đưa lên form trong excel nhưng không biết làm sao. Mong Anh Hai Lúa đi ngang vào giúp đỡ.
Nhấp chuột vào đây để mở rộng...
Thường thì người ta sẽ lưu đường dẫn đế chổ chứa hình, sau đó đọc hình từ đường dẫn là được. Cách này đỡ tốn dung lượng chứa hình vào file hơn.

Code ví dụ như sau:
Mã: 
Option Explicit

Private Sub ListBox1_Change()
   Dim lItem As Long
    For lItem = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(lItem) = True Then
            Image1.Picture = LoadPicture(ThisWorkbook.Path & ListBox1.List(ListBox1.ListIndex, 2))
        End If
    Next
End Sub
Private Sub UserForm_Initialize()
    Dim cn As Object, rst As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Driver={Microsoft Access Driver (*.mdb)};Dbq=" & ThisWorkbook.Path & "\data.mdb;Uid=Admin;Pwd=;")
    Set rst = cn.Execute("select * from [tbl_Hinh]")
    If Not (rst.bof And rst.EOF) Then
        Me.ListBox1.ColumnCount = rst.Fields.Count
        Me.ListBox1.Column = rst.getrows()
        rst.Close
    End If
End Sub

1.jpg

Tải file và giải nén, sau đó mở file FileTest.xls nhé.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

S
cần xử lý dữ liệu trùng nhau bằng VBA (4 người xem)
    • Cười
Trả lời
2
Đọc
16
SA_DQ
SA_DQ
N
Tạo file lưu trữ dữ liệu tự động trên excel.
Trả lời
7
Đọc
100
le_vis
L
N
  • Question Question
Tạo file lưu trữ dự liệu tự động
Trả lời
6
Đọc
119
Hoàng Tuấn 868
H
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
505
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian (1 người xem)
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn (1 người xem)
Trả lời
3
Đọc
132
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (5 người xem)
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ
Trả lời
4
Đọc
96
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
75
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN (1 người xem)
Trả lời
2
Đọc
72
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
294
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
613
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
147
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng (1 người xem)
Trả lời
1
Đọc
127
HUONGHCKT
H
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom