Cách update CSDL từ Excel (2 người xem)

[mrtq_86]

Hi all,
Sau 1 thời gian mày mò tìm cách update giờ mới đc.
Các bạn tham khảo góp ý.



Thanks

 

[mrtq_86]

Đây là hàm get New ID dựa trên ID trong CSDL tăng 1
Tuy nhiên chưa kiểm tra được ID có trùng trong CSDL không?
Bạn nào biết sửa lại giùm.

Sub AddIDNew()
Dim srcRng As Range, Arr, i As Long, n As Long
On Error GoTo Handle
Dim lsSQL As String: Dim rst As New ADODB.Recordset
Dim table As Variant
'On Error GoTo NothingChosen
Dim LastRow As Long
Dim DonVi As String
table = "tblVDV" & Sheet3.Cells(3, 9)


    If cnn.State <> 1 Then Moketnoi
        DonVi = Sheet1.cboDonVi
         'MsgBox LastRow: Exit Sub
        Set srcRng = Range([E6], [E5000].End(xlUp))
        lsSQL = "Select * from " & table & " where F0 Like '" & DonVi & "%' "
        'lsSQL = "Select * from " & table & " where F0 Like 'PV11001' "
                                rst.Open lsSQL, cnn, 3, 1
    


        Arr = srcRng.Value
        n = rst.RecordCount
        For i = 1 To UBound(Arr, 1)
              If Arr(i, 1) <> "" Then
                n = n + 1
                Arr(i, 1) = (DonVi) & Format(n, "000")
              End If
        Next
            srcRng.Offset(0, -2).Value = Arr
            'STTTONGHOP
            'calculateage
            'Addborder
            
            On Error Resume Next
            'Worksheet.Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
            rst.Close
            Set rst = Nothing
            cnn.Close
            Set cnn = Nothing


    Exit Sub


Handle:
MsgBox Err.Description


End Sub

 

[mrtq_86]

Các bạn dùng code add new id này chuẩn hơn.
Get ID lớn nhất trong bảng sẽ không bị trùng. Có ai có ý kiến gì ko?

Sub AddIDNew()
Dim srcRng As Range, Arr, i As Long
Dim n As String
'On Error GoTo Handle
Dim lsSQL As String: Dim rst As New ADODB.Recordset
Dim table As Variant
Dim LastRow As Long
Dim DonVi As String
table = "tblVDV" & Sheet3.Cells(3, 9)
'addnewrow
    If cnn.State <> 1 Then Moketnoi
        DonVi = Sheet1.cboDonVi.Value
         'MsgBox LastRow: Exit Sub
        Set srcRng = Range([E6], [E5000].End(xlUp))
        lsSQL = "Select MAX(F0) from " & table & " where F0 Like '" & DonVi & "%' "
        'lsSQL = "Select * from " & table & " where F0 Like 'PV11001' "
                                rst.Open lsSQL, cnn, 3, 1
        'MsgBox lsSQL: Exit Sub
        'If srcRng <= 0 Then: addnewrow: Exit Sub
        rst.MoveFirst
        n = Right(rst.Fields(0).Value, 3)
        Arr = srcRng.Value
        'Arr = rst!F0 + 1
        'n = rst.MaxRecords
       
        'MsgBox n: Exit Sub
        For i = 1 To UBound(Arr, 1)
              If Arr(i, 1) <> "" Then
                n = n + 1
                Arr(i, 1) = (DonVi) & Format(n, "000")
              End If
        Next
            srcRng.Offset(0, -2).Value = Arr
            'STTTONGHOP
            'calculateage
            'Addborder
            
            On Error Resume Next
            'Worksheet.Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            On Error GoTo 0
            rst.Close
            Set rst = Nothing
            cnn.Close
            Set cnn = Nothing


    Exit Sub


'Handle:
'MsgBox Err.Description


End Sub