Các bài tập VBA đơn giản dùng để xử lí CSDL (cơ sở dữ liệu) [Fần 3] (1 người xem)

[SA_DQ]

PHẦN GIỚI THIỆU​

Tạo 1 CSDL trong & xử lí nó để fục vụ cho công tác quản lí là nhu cầu có thực đang diễn ra hàng ngày tại các công sở, cơ quan sản xuất kinh doanh, dịch vụ,. . . .
Để tạo dựng nó ta cần thông qua các bước cơ bản sau đây:

Thiết kế: Tạo dựng các trang tính, bảng biểu,. . .

Vận hành: Gồm các công đoạn nhập dữ liệu, chỉnh sửa & làm ra các báo cáo tổng hợp hay chi tiết

Bảo trì & fát triển:

Đầu tiên xin giới thiệu đến các bạn 1 CSDL dùng để nhập hàng hóa từ nhà cung cấp;
Hiện tại trong file đính kèm ta chỉ có 3 trang tính.

Đó là trang "DMuc" sẽ gồm các bảng liệt kê hàng hóa. Thường nó có các trường sau: [TT], [Mã hàng], [Tên hàng], [Đơn vị tính], [Tồn Đầu],. . . .

Thứ đến là trang nhập dữ liệu
Trang này thường có hai fần; Mình tạm gọi là fần chung & fần chi tiết
Fần chung gồm các mục: Ngày tháng, Số fiếu, Nhà cung cấp, Mã NCC,. . . .
Fần chi tiết gồm các mục: [Mã hàng], [Tên hàng], [ĐVT], [Số lượng], [Ghi chú],. . .
Trang này dùng để nhập dữ liệu vô trang CSDL (mà trong file có tên là 'CTiet')

Trang chứa thông tin CSDL ('CTiet')
Trang này gồm 2 bảng; Một bảng chứa những dữ liệu có trong fần chung & 1 bảng chứa dữ liệu fần chi tiết bên trên ta vừa nêu
Một điều hết sức quan trọng là 2 bảng biểu này liên hệ khắng khít với nhau thông qua trường [Số fiếu]

Tác giả file này đã thiết lập qui trình để tạo ra số fiếu này. Chúng được tạo ra theo sự tăng dần của các ngày lập fiếu & trong 1 ngày thì tăng theo thứ tự của 3 kí số cuối.

Các bạn có thể tham khảo thêm các bài viết về CSDL trong excel có trên diễn đàn, chẳng hạn:
http://www.giaiphapexcel.com/forum/showthread.php?6159-Tạo-CSDL-trên-Excel
Nội dung bài tập đầu tiên sẽ có ở bài sau kế tiếp

Chúc vui & hạnh phúc!

 

[Vo Tinh]

Chia để trị dễ bảo trì hơn nhiều đó bạn!

Em đã chỉnh sửa theo hướng dẫn của Bác, cám ơn Bác đã tận tình

Private Sub Worksheet_Activate()
Dim sh As Worksheet
Set sh = Sheets("DMuc")
    [A8].CurrentRegion.Offset(1, 0).ClearContents
    sh.[A1].CurrentRegion.Copy [A7]
    Application.CutCopyMode = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C5]) Is Nothing Then
    Dim sh As Worksheet, lastRowCT As Long, lastRowDM As Integer, i As Long, j As Long, myStr As String, sArr, sArr2, rArr
    Dim startDay As Date, finishDay As Date, n As Single, x As Single, nt As Single, xt As Single
    Set sh = ThisWorkbook.Worksheets("CTiet")
    startDay = [C4].Value:                     finishDay = [C5].Value
    lastRowCT = sh.[R1].CurrentRegion.Rows.Count
    lastRowDM = Sheets("DMuc").[A1].CurrentRegion.Rows.Count
    ReDim sArr(1 To lastRowCT, 1 To 6):        sArr = sh.Range("R2:W" & lastRowCT)
    ReDim sArr2(1 To lastRowDM - 1, 1 To 4):   sArr2 = Sheets("Dmuc").Range("B2:F" & lastRowDM)
    ReDim rArr(1 To lastRowDM - 1, 1 To 5)
    For i = 1 To lastRowDM - 1
        n = 0: nt = 0
        x = 0: xt = 0
            For j = 1 To lastRowCT - 1
                If sArr(j, 2) = sArr2(i, 1) Then
                    myStr = sArr(j, 1)
                    If TraMa(myStr) < startDay Then
                        If Mid(sArr(j, 1), 4, 1) = "N" Then
                            nt = nt + sArr(j, 5)
                        ElseIf Mid(sArr(j, 1), 4, 1) = "X" Then
                            xt = xt + sArr(j, 5)
                        End If
                    ElseIf TraMa(myStr) >= startDay And TraMa(myStr) <= finishDay Then
                        If Mid(sArr(j, 1), 4, 1) = "N" Then
                            n = n + sArr(j, 5)
                        ElseIf Mid(sArr(j, 1), 4, 1) = "X" Then
                            x = x + sArr(j, 5)
                        End If
                    End If
                End If
            Next j
        rArr(i, 1) = sArr2(i, 4) + nt - xt
        rArr(i, 2) = nt - xt
        rArr(i, 3) = n
        rArr(i, 4) = x
        rArr(i, 5) = rArr(i, 1) + n - x
    Next i
    [F8].Resize(lastRowDM - 1, 5).Value = rArr
    Columns("G:G").EntireColumn.Hidden = True
    Range("C4").Select
    Set sArr = Nothing
    Set sArr2 = Nothing
    Set rArr = Nothing
End If
End Sub

 

[ChanhTQ@]

Bạn tham khảo thêm macro sự kiện này:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [c5]) Is Nothing Then
    Dim Sh As Worksheet, Arr(), Cls As Range
    Dim MaND$, MaNC$
    Dim J&, TonDK#, Nhap#, Xuat#, HS%
    
    Set Sh = ThisWorkbook.Worksheets("CTiet")
    Arr() = Sh.[R2].CurrentRegion.Offset(1).Value
    MaND = TaoMa(Target.Offset(-1).Value)
    MaNC = TaoMa(Target.Value)
    J = [d8].CurrentRegion.Rows.Count
    Union([f8].Resize(J), [h8].Resize(J, 2)).ClearContents
    Application.ScreenUpdating = False
    For Each Cls In Range([b8], [b8].End(xlDown))
        For J = 1 To UBound(Arr())
            If Arr(J, 2) = Cls.Value Then
                If Left(Arr(J, 1), 3) < MaND Then
                    If InStr(Arr(J, 1), "N") Then HS = 1 Else HS = -1
                    Cls.Offset(, 4) = Cls.Offset(, 4).Value + HS * Arr(J, 5)
                ElseIf Left(Arr(J, 1), 3) >= MaND And Left(Arr(J, 1), 3) <= MaNC Then
                    If InStr(Arr(J, 1), "N") Then HS = 0 Else HS = 1
                    Cls.Offset(, 6 + HS) = Cls.Offset(, 6 + HS).Value + Arr(J, 5)
                End If
            End If
        Next J
    Next Cls
    Application.ScreenUpdating = True
 End If
End Sub

 

[SA_DQ]

Bài tập 6: Sửa số liệu đã nhập ở 1 fiếu nào đó trong CSDL

Một CSDL sẽ đảm bảo an toàn hơn 1 khi ta không nhập trực tiếp dữ liệu lên nó.
Điều này chúng ta đã áp dụng bằng việc lấy 1 trang tính làm Form nhập liệu & nhờ macro chuyển dữ liệu vô CSDL.

Nhưng trong quá trình vận hành CSDL, tất iếu cần chỉnh sửa số liệu bỡi 1 lí do hoặc chủ quan (nhập nhằm không fát hiện sớm) hay khách quan (do nhà cung cấp đổi số lượng,. . .), . . .
Vẫn theo nguyên tắc đảm bảo an toàn cho CSDL là trên hết, chúng ta nên lấy 1 trang tính mới để làm công việc chỉnh sửa. (Thực ra chúng ta cũng có thể lấy trang 'NX' cũng được, nhưng dễ có nguy cơ hư CSDL do trình độ chúng ta còn bất cập)

Chúng ta bắt đầu với trang tính mới &
thiết kế tương tư như hình.

Khi ta nhập 1 ngày bất kì vô [C3] thi macro sự kiện sẽ hiện toàn bộ các fiếu nhập & fiếu xuất trong ngày đó ở cột trống [H:H] (Ở đây ta coi như ngày đó có fiếu cần điều chỉnh số liệu.)
Ta lấy 1 trong các số fiếu hiển thị đem nhập vô [c4] thì,
1 macro sự kêện khác tại đây sẽ liệt kê toàn bộ nội dung của fiếu ở vùng chi tiết.

[Tiến hành sửa chữa số liệu bảng ghi vừa hiện]

Sau đó ta bấm vô nút 'Luu' thì kết quả các chi tiết của fiếu trước đây đã nhập sẽ bị xóa & các chi tiết mới sẽ được nạp vô CSDL.

Chúc các bạn thành công!

 

[doveandrose]

thêm cũng như sửa , sửa cũng là thêm

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$3" Or Target.Address = "$D$3" Then
    CreateValidateC4
End If
If Target.Address = "$C$4" Then
    Dim lr As Long, wsCT As Worksheet, wsNX As Worksheet
    Set wsNX = Worksheets("NX")
    Set wsCT = Worksheets("CTiet")
    wsNX.[B10:B109].ClearContents
    wsNX.[E10:E109].ClearContents
    With wsCT
        lr = .[R65000].End(xlUp).Row + 1
        .Range("R1:W" & lr).AutoFilter 1, wsNX.[C4].Value
        If .[R65000].End(xlUp).Row > 1 Then
            .Range("S2:S" & lr).SpecialCells(xlCellTypeVisible).Copy wsNX.[B10]
            .Range("V2:V" & lr).SpecialCells(xlCellTypeVisible).Copy wsNX.[E10]
        End If
        .[A1].AutoFilter
    End With
End If
End Sub

Private Sub MyCmd_Click()
Dim arr As Variant, tpArr(1 To 1, 1 To 2) As Variant, ctpArr(1 To 100, 1 To 5) As Variant
Dim n As Integer, r As Integer, c As Integer, lr As Long, adrDl As String
With Worksheets("NX")
    If WorksheetFunction.Trim(.[C4].Value) = "" Then
        MsgBox "hello world"
        Exit Sub
    End If
    arr = .Range("B10:E109").Value
    tpArr(1, 1) = .Range("C3").Value2
    tpArr(1, 2) = .Range("C4").Value
End With
For r = 1 To 100 Step 1
    If arr(r, 1) <> "" Then
        n = n + 1
        ctpArr(n, 1) = tpArr(1, 2)
        For c = 2 To 5 Step 1
            ctpArr(n, c) = arr(r, c - 1)
        Next
    End If
Next
If n > 0 Then
    With Worksheets("CTiet")
        lr = .[B65000].End(xlUp).Row + 1
        If TypeName(Application.Match(tpArr(1, 2), .Range("C1:C" & lr), 0)) = "Error" Then
            .Range("B" & lr & ":C" & lr).Value = tpArr
        End If
        lr = .[R65000].End(xlUp).Row + 1
        .Range("R1:W" & lr).AutoFilter 1, tpArr(1, 2)
        If .[R65000].End(xlUp).Row > 1 Then
            adrDl = .Range("R2:W" & lr).SpecialCells(xlCellTypeVisible).Address
        End If
        .[A1].AutoFilter
        If adrDl <> "" Then .Range(adrDl).Delete xlUp
        lr = .[R65000].End(xlUp).Row + 1
        .Range("R" & lr & ":V" & (lr + n - 1)).Value = ctpArr
    End With
    Worksheets("NX").Range("B10:B109").ClearContents
    Worksheets("NX").Range("E10:E109").ClearContents
End If
CreateValidateC4
End Sub

Public Sub CreateValidateC4()
Dim Msn As String, wsNX As Worksheet, wsCT As Worksheet
Dim lr As Long, r As Long, arrValidate(1 To 1000) As String, arr As Variant
Set wsNX = Worksheets("NX")
Set wsCT = Worksheets("CTiet")
Application.ScreenUpdating = False
With wsCT
    wsNX.[K1:L1].Value = .[C1].Value
    lr = .[B65000].End(xlUp).Row + 1
    Msn = TaoMa(wsNX.[C3].Value) & wsNX.[D3]
    wsNX.[k2].Value = Msn & "*"
    .Range("C1:C" & lr).AdvancedFilter xlFilterCopy, wsNX.[K1:K2], wsNX.[L1]
End With


With wsNX
    If .[L2].Value <> "" Then
        lr = .[L1].End(xlDown).Row
        .[L1].Value = Msn & Format(Val(Right(.Range("L" & lr).Value, 3) + 1), "000")
    Else
        .[L1].Value = Msn & "001"
        lr = 1
    End If
    For r = 1 To lr Step 1
        arrValidate(r) = .Range("L" & r)
    Next
    .[C4].Validation.Delete
    .[C4].Validation.Add xlValidateList, xlValidAlertStop, , Join(arrValidate, ",")
    .[C4].Value = .[L1].Value
    .[K1].CurrentRegion.ClearContents
End With
Application.ScreenUpdating = True
End Sub

 

[Vo Tinh]

Khi ta nhập 1 ngày bất kì vô [C3] thi macro sự kiện sẽ hiện toàn bộ các fiếu nhập & fiếu xuất trong ngày đó ở cột trống [H:H] (Ở đây ta coi như ngày đó có fiếu cần điều chỉnh số liệu.)
Ta lấy 1 trong các số fiếu hiển thị đem nhập vô [c4] thì,
1 macro sự kêện khác tại đây sẽ liệt kê toàn bộ nội dung của fiếu ở vùng chi tiết.
[Tiến hành sửa chữa số liệu bảng ghi vừa hiện]
Sau đó ta bấm vô nút 'Luu' thì kết quả các chi tiết của fiếu trước đây đã nhập sẽ bị xóa & các chi tiết mới sẽ được nạp vô CSDL.
Chúc các bạn thành công!

Em cũng xin nộp bài Bác Sa và các AC xem giúp.
Trên sheet sử dụng các vùng tạm :
- [J1:J2] : điều kiện "số phiếu" để lọc AF với J2 = C4
- [L1:L ..]: row của các record nhằm định vị dòng chép ngược dữ liệu chỉnh sửa vào lại CTiet

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C3]) Is Nothing Then
    Dim myRg As Range, i As Long
    Dim myRg2 As Range, k%, rgRow As Range, lastRow As Integer
    Set myRg = Sheets("CTiet").[B2].CurrentRegion
    [H1].CurrentRegion.Offset(1, 0).ClearContents
    [C4].Value = ""
        For i = 2 To myRg.Rows.Count
            If myRg(i, 1) = [C3] Then
            k = k + 1
            [H1].Offset(k, 0).Value = myRg(i, 2).Value
            End If
        Next i
ElseIf Not Intersect(Target, [C4]) Is Nothing Then
    Set myRg2 = Sheets("CTiet").[R1].CurrentRegion
    lastRow = myRg2.Rows.Count
    Union(Range("B10:B" & lastRow), Range("E10:E" & lastRow)).ClearContents
    [J1] = myRg2(1, 1).Value 
    myRg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[B9], Unique:=False
    myRg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[E9], Unique:=False
    [L1].CurrentRegion.Offset(1, 0).ClearContents
        For i = 1 To lastRow
            If myRg2(i, 1) = [C4] Then
                k = k + 1
                [L1].Offset(k, 0) = i
            End If
        Next i
End If
End Sub

Private Sub CommandButton1_Click()Dim rW As Long, myRg As Range, myRg2 As Range, myRg3 As Range, sh As Worksheet
Dim i As Integer, j As Integer
Set sh = Sheets("SuaDL")
If [B10] = "" Then Exit Sub
rW = [L1].CurrentRegion.Rows.Count
    Set myRg = sh.Range("L2:L" & rW)
    Set myRg2 = sh.Range("B10:E" & rW + 10)
    Set myRg3 = Sheets("CTiet").[R1].CurrentRegion
        For i = 1 To myRg.Rows.Count
            For j = 1 To 4
                myRg3(myRg(i, 1), j + 1) = myRg2(i, j).Value
            Next j
        Next i
End Sub

 

[SA_DQ]

[Bài đọc thêm]

Fần macro sự kiện được trính dẫn dưới đây là để liệt kế các số fiếu nhập cũng như xuất có trong ngày cần tìm.

 Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C3]) Is Nothing Then
    Dim myRg As Range, i As Long
    Dim myRg2 As Range, k%, rgRow As Range, lastRow As Integer
    Set myRg = Sheets("CTiet").[B2].CurrentRegion
    [H1].CurrentRegion.Offset(1, 0).ClearContents
    [C4].Value = ""
        For i = 2 To myRg.Rows.Count
            If myRg(i, 1) = [C3] Then
            k = k + 1
            [H1].Offset(k, 0).Value = myRg(i, 2).Value
            End If
        Next i
ElseIf Not Intersect(Target, [C4]) Is Nothing Then
   ‘. . . . . . ‘
End If
End Sub

Tuy nhiên nếu cần chạy macro này ở giai đoạn cuối năm, khi mà số fiếu là độ sộ thì sẽ là lâu.
Lí do lâu là bạn xài vòng lặp duyệt từ ngày đầu đền ngày cuối, tất tần tật, không sót tên nào.

Nhưng có cách những khác sẽ cải thiện tốc độ đáng kể, trong đó có 1 cách trong tầm tay của bạn đó là áp dụng fương thức tìm kiếm (FIND method; bạn có thể tìm hiểu qua loạt bài của HoangDanh282VN tại địa chỉ: http://www.giaiphapexcel.com/forum/...ợp-về-phương-thức-tìm-kiếm-FIND-(Find-Method) )

Nhưng khoan hãy đọc hết nó lúc này, Mình xin chắc lọc ra những cái thiết iếu cho bạn lúc này, đó là:
Không nên tìm theo ngày đã định (với bạn lúc này), mà nên tìm chuỗi biểu thị ngày đã được hàm tự tạo mã hóa số liệu ngày ở cột bên fải cột ghi ngày. Tất nhiên lúc này ta cần áp dụng tìm với tham biến xlPart (chứ không xài xlWhole)
Tại sao lại đi vòng vo làm vậy: Vì tìm số liệu ngày tháng khó hơn rất nhiều so với số liệu kiểu khác (ngày-tháng-năm) hay dữ liệu kiểu chuỗi, ngay cả với mình cũng có lúc nhầm lẫn.

Thật ra trong file nào đó ở trên chúng ta đã gặp macro này:

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range, Sh As Worksheet, MyAdd$
 
 If Not Intersect(Target, [D3]) Is Nothing Then
    Union([H1:H999], [C4]).ClearContents
    Set Sh = ThisWorkbook.Worksheets("CTiet")
    Set Rng = Sh.Range(Sh.[C1], Sh.[C1].End(xlDown))
    Set sRng = Rng.Find(TaoMa([C3].Value) & Target.Value, , xlFormulas, xlPart)
    If sRng Is Nothing Then
        [C4].Value = TaoMa([C3].Value) & Target.Value & "001"
    Else
        MyAdd = sRng.Address
        Do
            [h999].End(xlUp).Offset(1).Value = sRng.Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 End If
End Sub

Lúc rỗi bạn thử giành thời gian cho nó xem sao. Tuy có vẻ dài vì nhiều dòng lệnh hơn, nhưng đảm bảo nhanh hơn vòng lặp bên trên. (Vì lí do đơn giản là nó sẽ chỉ nhảy cóc từ ô được tìm thấy này đến ô được tìm thấy khác)

 

[Vo Tinh]

Em làm lại theo phương thức FIND, cám ơn chia sẻ của Bác

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C3]) Is Nothing Then
    Dim myrg As Range, smyRg As Range, i As Long, sh As Worksheet
    Dim myrg2 As Range, k As Integer, lastRow As Integer, myRow As Long
    Set sh = ThisWorkbook.Worksheets("CTiet")
    Set myrg = sh.Range(sh.[C2], sh.[C2].End(xlDown))
    [H1].CurrentRegion.Offset(1, 0).ClearContents
    [C4].Value = ""
    Set smyRg = myrg.Find(TaoMa([C3]), , LookIn:=xlValues, LookAt:=xlPart)
        If Not smyRg Is Nothing Then
        myRow = smyRg.Row
        Do
            k = k + 1
            [H1].Offset(k, 0).Value = smyRg
            Set smyRg = myrg.FindNext(smyRg)
        Loop While smyRg.Row <> myRow
        End If
ElseIf Not Intersect(Target, [C4]) Is Nothing Then
    Set myrg2 = sh.[R1].CurrentRegion
    lastRow = myrg2.Rows.Count
    Union(Range("B10:B" & lastRow), Range("E10:E" & lastRow)).ClearContents
    [L1].CurrentRegion.Offset(1, 0).ClearContents
    [J1] = myrg2(1, 1).Value
    If [C4].Value = "" Then Exit Sub
    myrg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[B9], Unique:=False
    myrg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[E9], Unique:=False
    Set smyRg = myrg2.Find([C4], , LookIn:=xlValues, LookAt:=xlWhole)
        If Not smyRg Is Nothing Then
            Do
                k = k + 1
                [L1].Offset(k, 0).Value = smyRg.Row
            Set smyRg = myrg2.FindNext(smyRg)
            Loop While smyRg.Row <> [L2]
        End If
End If
End Sub

 

[SA_DQ]

1 lưu í với bạn, tuy nhỏ:

Nếu bạn xài câu lệnh

Option Explicit

Thì macro của bạn sẽ báo lỗi.

Với mình thì luôn xài câu lệnh này!

 

[Let'GâuGâu]

Nếu bạn xài câu lệnh

Option Explicit

Thì macro của bạn sẽ báo lỗi.

Với mình thì luôn xài câu lệnh này!

cho em hỏi, vì sao phải xài dòng lệnh này vậy
em thấy một số vị, viết code chuyên nghiệp hay dùng nó, nhưng ko hiểu tác dụng để làm gì?, vì bỏ nó code vẫn chạy mà?

 

[chuot0106]

cho em hỏi, vì sao phải xài dòng lệnh này vậy
em thấy một số vị, viết code chuyên nghiệp hay dùng nó, nhưng ko hiểu tác dụng để làm gì?, vì bỏ nó code vẫn chạy mà?

Theo cách hiểu nông cạn của tôi thì nếu bỏ dòng lệnh này đi thì trong sub không cần khai báo biến thì code vẫn chạy và ko báo lỗi. Còn nếu có dòng lệnh này thì ngược lại.

 

[Vo Tinh]

Nếu bạn xài câu lệnh

Option Explicit

Thì macro của bạn sẽ báo lỗi.

Với mình thì luôn xài câu lệnh này!

Đã kiểm tra lại đúng là báo lỗi.
Do khi post bài lên lúc xem lại thì sửa Sheets("CTiet") thành sh
Em sửa lại rồi và macro chạy được nhưng chưa hiểu tại sao vì mình đã Set sh rồi mà vẫn bị lỗi như thế.
Cám ơn Bác

Sửa dòng này

Set myrg2 =[COLOR=#ff0000] sh[/COLOR].[R1].CurrentRegion

Thành dòng này

Set myrg2 = [COLOR=#ff0000]Sheets("CTiet")[/COLOR].[R1].CurrentRegion

 

[ChanhTQ@]

Một điều hiển nhiên rằng nếu không có dòng lệnh đó thì nó - VBA không báo cho ta lỗi tiềm ẩn. Rằng bạn Vo Tinh chỉ khai báo biến cho 1 vùng lệnh, mà chưa khai biến cho toàn bộ macro.

Nếu cho là mình chưa qua trường lớp thì không thể làm code theo kiểu tài tử được; Mọi cái nên tường minh, không huyễn hoặc bản thân được

Rồi 1 chục năm sau, khi đọc lại code của mình mà như đọc lại code của ai xa lạ!

Tuy ta tiết kiệm được 1 vài fút hiện tại, nhưng sau này sẽ tốn nhiều hơn bội lần khi đọc lại nó.

Nhưng dù sao đó cũng là thói quen của từng người, tùy vậy, . . . .

 

[phihndhsp]

cho em hỏi, vì sao phải xài dòng lệnh này vậy
em thấy một số vị, viết code chuyên nghiệp hay dùng nó, nhưng ko hiểu tác dụng để làm gì?, vì bỏ nó code vẫn chạy mà?

Nếu có câu lệnh đó thì VBA bảo rằng mọi biến được xài thì phải được khai báo. Và khai báo biến trước khi sử dụng sẽ giúp người lập trình dễ kiểm soát chương trình hơn. Nếu có câu lệnh đó mà không khai báo biến trước khi dùng thì chương trình sẽ báo lỗi. Chính vì báo lỗi nên các thành viên thường bỏ nó đi, đó là một sai lầm lớn trong lập trình. Và nó sẽ làm cho đoạn code của mình khó đọc và khó kiểm soát

 

[VetMini]

cho em hỏi, vì sao phải xài dòng lệnh này vậy
em thấy một số vị, viết code chuyên nghiệp hay dùng nó, nhưng ko hiểu tác dụng để làm gì?, vì bỏ nó code vẫn chạy mà?

Đỏ: không ai bắt bạn phải xài cả. Lý do tại sao người ta hay xài thì cứ xem tiếp.
Xanh: đối với người code chuyên nghiệp, từ "vẫn chạy" không có nghĩa lý gì cả. Bởi vì code có thể chạy ầm ầm nhưng kết quả sai bấy.

Có hai lý do NÊN dùng dòng lệnh ấy:

1. Nó giúp cho bạn loại trừ được một số trường hợp gõ sai chính tả
Ví dụ bạn có biến tongHop, ở một dòng nào đó bạn gõ nhâm thành tongHip.
tongHop = 1000
For i = 1 to 10
tongHip = tongHop + 1
Next i
Nếu không có lệnh buộc khai báo thì VBA mặc nhiên coi tongHip là một biến mới. Và kết quả cuối cùng của bạn là tongHop = 1000, thay vì 1010 mới đúng
Nếu có lệnh buộc khai báo thì VBA sẽ báo lỗi cho bạn kịp thời sửa
Lưu ý là tôi chỉ nói "một số trường hợp", không phải tất cả. Tuy vậy, kinh nghiệm tôi thấy nó giúp tôi tránh lỗi đến gần 90%. Rất xứng đáng dùng.

2. Khai báo biến tường minh không hẳn là để 10 năm sau đọc lại như nhiều người nghĩ. Việc khai báo biến tường minh giúp bạn tránh bị lẫn lộn giữa biến toàn cục và biến nội bộ.
Ví dụ đầu module bạn khai một biến tumLum thì trong tất cả các sub có sử dụng tumLum:
- sub nào có khai tumLum thì đây là biến riêng của nó, chả liên quan gì đến biến tumLum khai ở trên.
- sub nào không có khai tumLum mà sử dụng tumLum thì mặc nhiên là nó sử dụng biến toàn cục khai ở trên.
Nếu biến toàn cục được khai là public thì càng nguy hiểm hơn nữa. Ở một sub nào đó, bạn có thể sử dụng biên tumLum mà không biết rằng nó gây ảnh hưởng đến các sub khác. Nếu bạn có khai bào tumLum trong sub của mình thì bạn có thể yên tâm là không ai bị ảnh hưởng cả.

 

[Kiều Mạnh]

Theo mình nghĩ đơn giản là vầy
phải xài dòng lệnh này Option Explicit
Thì khi viết code phải khai báo tường minh nó giúp cho mình rất nhiều về chính tả ...nếu viết bỏ bớt ngắn gọn không khai báo tường minh.... nếu bạn nào đó copy qua máy khác có Option Explicit là lỗi code...
khi viết code có Option Explicit thì có từ gợi ý và code chạy nhanh hơn một tẹo ....còn không thì ...

Ví dụ Sau nếu có Option Explicit thì sub sau phải Dim nọ Dim kia nếu không là lỗi còn nếu Dim đầy đấy đủ hết thì có Option Explicit hay không nó vẫn chạy

Sub ViDu()
    n = [A1:C20].Value
    [J1].Resize(UBound(n), 3) = n
End Sub

 

[SA_DQ]

Em làm lại theo phương thức FIND, cám ơn chia sẻ của Bác

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C3]) Is Nothing Then
Dim myrg As Range, smyRg As Range, i As Long, sh As Worksheet
Dim myrg2 As Range, k As Integer, lastRow As Integer, myRow As Long
Set sh = ThisWorkbook.Worksheets("CTiet")
Set myrg = sh.Range(sh.[C2], sh.[C2].End(xlDown))
[H1].CurrentRegion.Offset(1, 0).ClearContents
[C4].Value = ""
Set smyRg = myrg.Find(TaoMa([C3]), , LookIn:=xlValues, LookAt:=xlPart)
If Not smyRg Is Nothing Then
myRow = smyRg.Row
Do
k = k + 1
[H1].Offset(k, 0).Value = smyRg
Set smyRg = myrg.FindNext(smyRg)
Loop While smyRg.Row <> myRow
End If
'. . . . . '
End Sub

Ngoài ra còn 1 con dao bén hơn nữa để xài trong trường hợp này; Đó là đưa dữ liệu cần tìm vô biến mãng thích hợp & duyệt trên mảng.
Việc này chúng ta đã đề cập ở vài bài nào đó bên trên.

Nếu không bận lắm, ngày cuối tuần hôm nay bạn thử xài con dao fẩu này xem sao!?!

(húc nhiều thành công!

 

[SA_DQ]

Hình như đoạn "code" này ở bài #47 đang có vấn đề cần rút gọn

ElseIf Not Intersect(Target, [C4]) Is Nothing Then
    Set myrg2 = sh.[R1].CurrentRegion
    lastRow = myrg2.Rows.Count
    Union(Range("B10:B" & lastRow), Range("E10:E" & lastRow)).ClearContents
    [L1].CurrentRegion.Offset(1, 0).ClearContents
    [J1] = myrg2(1, 1).Value
    If [C4].Value = "" Then Exit Sub
    myrg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[B9], Unique:=False
    myrg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[E9], Unique:=False
    Set smyRg = myrg2.Find([C4], , LookIn:=xlValues, LookAt:=xlWhole)
        If Not smyRg Is Nothing Then
            Do
                k = k + 1
                [L1].Offset(k, 0).Value = smyRg.Row
            Set smyRg = myrg2.FindNext(smyRg)
            Loop While smyRg.Row <> [L2]
        End If
End If

Theo mình chỉ cần lọc 1 lần & đưa vô vùng kết quả là được:

 ElseIf Not Intersect(Target, [C4]) Is Nothing Then
    If [C4].Value = "" Then Exit Sub
    Set Sh = ThisWorkbook.Worksheets("CTiet")
    Set Rng = Sh.[R1].CurrentRegion
    lastRow = Rng.Rows.Count
    [b10].Resize(16, 4).ClearContents
    Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], _
        CopyToRange:=[B9].Resize(, 4), Unique:=False
 End If

 

[Vo Tinh]

Thực tế thì hiện nay em luôn dùng Option Explicit
Cũng chính vì bị sai chính tả tên biến trong quá trình viết code vài lần và khi đọc code để học hỏi mà không thấy khai báo biến thì khó hiểu hơn, từ đó em set luôn Option Explicit trong Option.
Cũng nhờ sự cố vừa rồi em biết thêm biến có biến toàn macro, có biến chỉ cho 1 đoạn code do vị trí mình khai báo biến, rất cám ơn Bác và các AC đã chia sẻ.

Ngoài ra còn 1 con dao bén hơn nữa để xài trong trường hợp này; Đó là đưa dữ liệu cần tìm vô biến mãng thích hợp & duyệt trên mảng.
Việc này chúng ta đã đề cập ở vài bài nào đó bên trên.

Em thử làm mảng thế này mà không biết có phải là con dao bén không nữa

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim myRg As Range, smyRg As Range, i As Long, sh As Worksheet, sArr, sArr2, rArr, rArr2
    Dim myRg2 As Range, k As Integer, lastRow As Integer, myRow As Long
    Set sh = ThisWorkbook.Worksheets("CTiet")
    Set myRg = sh.Range(sh.[C2], sh.[C2].End(xlDown))
    Set myRg2 = sh.[R1].CurrentRegion
    lastRow = myRg2.Rows.Count
If Not Intersect(Target, [C3]) Is Nothing Then
    ReDim sArr(1 To myRg.Rows.Count)
    Set sArr = myRg
    ReDim rArr(1 To 1)
    [H1].CurrentRegion.Offset(1, 0).ClearContents
    [C4].Value = ""
    Set smyRg = sArr.Find(TaoMa([C3]), , LookIn:=xlValues, LookAt:=xlPart)
        If Not smyRg Is Nothing Then
            myRow = smyRg.Row
                Do
                    k = k + 1
                    ReDim Preserve rArr(1 To k)
                        rArr(k) = smyRg
                    Set smyRg = sArr.FindNext(smyRg)
                Loop While smyRg.Row <> myRow
            [H2].Resize(k) = WorksheetFunction.Transpose(rArr)
        End If
ElseIf Not Intersect(Target, [C4]) Is Nothing Then
    Union(Range("B10:B" & lastRow), Range("E10:E" & lastRow)).ClearContents
    [L1].CurrentRegion.Offset(1, 0).ClearContents
    [J1] = myRg2(1, 1).Value
        If [C4].Value = "" Then Exit Sub
            myRg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[B9], Unique:=False
            myRg2.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], CopyToRange:=[E9], Unique:=False
            ReDim sArr2(1 To myRg2.Rows.Count, 6)
            Set sArr2 = myRg2
            ReDim rArr2(1 To 1)
            Set smyRg = sArr2.Find([C4], , LookIn:=xlValues, LookAt:=xlWhole)
                If Not smyRg Is Nothing Then
                    myRow = smyRg.Row
                    Do
                        k = k + 1
                        ReDim Preserve rArr2(1 To k)
                            rArr2(k) = smyRg.Row
                            [L2].Resize(k) = WorksheetFunction.Transpose(rArr2)
                        Set smyRg = sArr2.FindNext(smyRg)
                    Loop While smyRg.Row <> myRow
                End If
        End If
End Sub

 

[Vo Tinh]

Hình như đoạn "code" này ở bài #47 đang có vấn đề cần rút gọn

Theo mình chỉ cần lọc 1 lần & đưa vô vùng kết quả là được:

 ElseIf Not Intersect(Target, [C4]) Is Nothing Then
    If [C4].Value = "" Then Exit Sub
    Set Sh = ThisWorkbook.Worksheets("CTiet")
    Set Rng = Sh.[R1].CurrentRegion
    lastRow = Rng.Rows.Count
    [b10].Resize(16, 4).ClearContents
    Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], _
        CopyToRange:=[B9].Resize(, 4), Unique:=False
 End If

Em cũng có nghĩ tới việc này nhưng theo em thì chỉ nên lọc Mã và Số lượng sang, từ Mã này dùng Vlookup trên sheet lấy 2 trường kia nhằm tránh trường hợp người dùng sửa sai Mã hoặc sai tên sau đó copy ngược vào CTiet sẽ hư mất dữ liệu.

Cám ơn Bác nhiều mong Bác vẫn hướng dẫn chia sẻ tiếp, em có đọc về VBA nhưng viết code thì Topic này là bắt đầu đấy Bác à, sau một tuần nhìn lại với các bài code thấy mình học được rất nhiều thứ từ Bác và các AC.

 

[doveandrose]

làm sao dùng lệnh ADO để xóa dòng dữ liệu

em xin hỏi : ta có thể dùng lệnh ADO để xóa 1 dòng dữ liệu được không ?
trong file dưới đây , lệnh Delete bị báo
Deleting data in a linked table is not supported by this ISAM
khi bấm vào nút "copy to" trong sheet "NX"
các thầy vui lòng sửa giúp . cảm ơn