Nhờ hướng dẫn (gợi ý) giải quyết vấn đề bằng VBA (2 người xem)

Liên hệ QC

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

tungnguyen_kt

Thành viên gắn bó
Thành viên BQT
Super Moderator
Tham gia
25/6/08
Bài viết
2,900
Được thích
12,083
Giới tính
Nam
Em xin phép mở topic này với hy vọng được trợ giúp từng bước để thực hành VBA.

Có thể có những câu hỏi "ngớ ngẩn" nhưng đằng sau những câu hỏi ấy là niềm mong mỏi các Thầy, các anh chị sớm giúp đỡ.

Câu hỏi "mở hàng" cho topic này như sau:

* Em muốn làm một form nhập liệu trong đó Combobox và cả textbox

Trong đó combobox lấy data từ list còn textbox là nhập liệu bình thường sau đó dữ liệu này sẽ chạy về 1 sheet

Thêm một cái nữa là ví dụ như: Combo_1 chọn mã khách hàng là NTT thì kế dưới là một texbox chẳng hạn sẽ lookup theo danh sách và tự động hiện luôn trên textbox này để kiểm tra.

Thông cảm diễn giải câu hỏi dài dòng (mà chưa chắc rõ) cũng vì cái tội quá kém VBA.

Rất mong anh chị sớm quan tâm hướng dẫn em làm.
 
Em xin phép mở topic này với hy vọng được trợ giúp từng bước để thực hành VBA.

Có thể có những câu hỏi "ngớ ngẩn" nhưng đằng sau những câu hỏi ấy là niềm mong mỏi các Thầy, các anh chị sớm giúp đỡ.

Câu hỏi "mở hàng" cho topic này như sau:

* Em muốn làm một form nhập liệu trong đó Combobox và cả textbox

Trong đó combobox lấy data từ list còn textbox là nhập liệu bình thường sau đó dữ liệu này sẽ chạy về 1 sheet

Thêm một cái nữa là ví dụ như: Combo_1 chọn mã khách hàng là NTT thì kế dưới là một texbox chẳng hạn sẽ lookup theo danh sách và tự động hiện luôn trên textbox này để kiểm tra.

Thông cảm diễn giải câu hỏi dài dòng (mà chưa chắc rõ) cũng vì cái tội quá kém VBA.

Rất mong anh chị sớm quan tâm hướng dẫn em làm.
Vấn đề là đã biết làm CN hay TextBox chưa hay là hướng dẫn từ đầu về VBA.
Record macro
A1=1
A2=2
A3=A1+A2
msgbox A3
Tùng nên làm sẵn 1 file demo gồm List gì, CB lấy cái gì thì mối biết mà chỉ.
bmvnah
 
Vấn đề là đã biết làm CN hay TextBox chưa hay là hướng dẫn từ đầu về VBA.
Record macro
A1=1
A2=2
A3=A1+A2
msgbox A3
Tùng nên làm sẵn 1 file demo gồm List gì, CB lấy cái gì thì mối biết mà chỉ.
bmvnah

Có ngay đây Thầy ơi

.........................................
 

File đính kèm

cho e hỏi 1 câu được không a?
có cách nào khi copy past mà chỉ có thể past vào các ô trống. còn các ô có dữ liệu thì không thể past đè lên được không ạ
cám ơn mọi người.
 
cho e hỏi 1 câu được không a?
có cách nào khi copy past mà chỉ có thể past vào các ô trống. còn các ô có dữ liệu thì không thể past đè lên được không ạ
cám ơn mọi người.
Sao tự nhiên chen ngang vào thế này? Cần hỏi gì thì mở chủ đề mới chứ!
 
xin lỗi chú. nhưng cháu là thành viên mới, ko biết mở chủ đề như thế nào cả. có gì không phải xin mọi người luongj thứ cho.
 
xin lỗi chú. nhưng cháu là thành viên mới, ko biết mở chủ đề như thế nào cả. có gì không phải xin mọi người luongj thứ cho.

Mình hướng dẫn sơ lược về cách tạo chủ đề mới
1/ Chọn mục "Diễn Đàn" & cũng nhớ Đăng nhập Nick của bạn
2/ Chọn tiếp Mục có liên quan đến vấn đề bạn muốn hỏi, tôi thấy Bài #4 mà bạn muốn hỏi sẽ liên quan đến mục"Lập trình với Excel" vậy tạm thời chọn mục này
3/ gần góc trên bên trái bạn sẽ thấy : "+Gởi đề tài mới" ---> chọn mục này & tiếp tục.
3/
 
Có ngay đây Thầy ơi

.........................................
Dùng form trên sheet quen nên quên cách làm.
Nhân bài của Tùng mới nhớ lại bài tạo form cách đây lâu lắm rồi.
Có thể làm được nhưng chả biết hướng dẫn.
Tiện đây nhờ các bạn hường dẫn cách tạo CB trên form từ Array giúp.
1/ Phần ngày chắc dùng DTPicker
3/ Phần định dạng số nhập có phân cách thì có code của SoiBien rồi
Chỉ còn phần 2 CB là chhưa biết làm thế nào cho hay. Dùng ListBox quen giờ quên cách dùng CB.
Phần định dạng thì dùng code.
PHP:
Private Sub txtScreen_Change()
Dim Value As String
Dim strFmt As String
Dim i As Integer
Dim decSep As String
Dim thsdSep As String

Value = txtscreen.Text
strFmt = ""

If Value Like "*" & "." & "*" & "." & "*" Then Value = Left(Value, Len(Value) - 1)
'check valid character
If Not (IsNumeric(Value) _
    Or Value = "-" _
    Or Value = "." _
    Or Value = "-0" _
    Or Value = "-." _
    Or Value = "-0.") _
    Or Right(Value, 1) = "," Then
        If Len(Value) > 0 Then Value = Left(Value, Len(Value) - 1)
Else
    ' Check Negative value with many 0 leader
    If Not (Left(Value, 1) = "-" And Val(Value) = 0) Then
        'start string Format
        strFmt = "#,##0"
        'check if it is Decimal or not
        If Value Like "*" & "." & "*" Then
            strFmt = strFmt & "."
            For i = 1 To Len(Value) - InStr(1, Value, ".")
                'Increase Zero Number after Decimal of strFmt
                strFmt = strFmt & 0
            Next
        End If
        strFmt = strFmt ' & ";-" & strFmt
        Value = Format(Value, strFmt)
    End If ' End check negative value with many 0 leader
End If ' End check valid Character

txtscreen.Text = Value

End Sub
Cám ơn các bạn nhiều.

Tóm gọn yêu cầu như sau
Tạo 1 CB trên form khi chọn MaKH thì TxtBox sẽ hiện tên KH.
 
Mình có thể dùng ADO để kết nối CSDL, chọn DL cần đưa vào CB.
 
Mình hướng dẫn thì kém lắm, bạn tự tham khảo nha
 

File đính kèm

Tạo 1 CB trên form khi chọn MaKH thì TxtBox sẽ hiện tên KH.

Như em đã nói ở trên mình dùng ADO để đưa dữ liệu vào Combo.
1./ Kết nối với CSDL là file hiện hành.

Mã:
Public cnn As New ADODB.Connection

Sub Moketnoi()
  With cnn
    .ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0; data source=" & _
                        ThisWorkbook.FullName & "; " & _
                        "Extended Properties=Excel 8.0;"
    .CursorLocation = adUseClient
    .Open
  End With
    
End Sub
2./ Chọn bảng ThongTin và đưa dữ liệu vào Combo:

Mã:
Private Sub UserForm_Initialize()
Dim arrValue As Variant
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
    Moketnoi
    lsSQL = "select * from [ThongTin$]"
       rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
       arrValue = rst.GetRows()
        With ComboBox1
            .Clear
            .List = arrValue
            .List = Application.Transpose(arrValue)
        End With
 rst.Close
 Set rst = Nothing
 cnn.Close
 Set cnn = Nothing
     
End Sub

3./ Khi chọn thay đổi dữ liệu trong Combo thì TexBox3 sẽ hiện tên theo tương ứng.

Mã:
Private Sub ComboBox1_Change()
TextBox3 = ComboBox1.Column(1)


End Sub

*/ Nhân tiện có bài viết này chúng ta sẽ tiếp tục bàn về ADO căn bản, mong các anh chị quan tâm thảo luận thêm.
- Làm sao để lấy dữ liệu duy nhất đưa vào Combo (Có 2 cách)
- Sắp xếp dữ liệu trong Combo theo thứ tự cột đầu tiên.
 

File đính kèm

Như em đã nói ở trên mình dùng ADO để đưa dữ liệu vào Combo.
1./ Kết nối với CSDL là file hiện hành.

Mã:
Public cnn As New ADODB.Connection

Sub Moketnoi()
  With cnn
    .ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0; data source=" & _
                        ThisWorkbook.FullName & "; " & _
                        "Extended Properties=Excel 8.0;"
    .CursorLocation = adUseClient
    .Open
  End With
    
End Sub
2./ Chọn bảng ThongTin và đưa dữ liệu vào Combo:

Mã:
Private Sub UserForm_Initialize()
Dim arrValue As Variant
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
    Moketnoi
    lsSQL = "select * from [ThongTin$]"
       rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
       arrValue = rst.GetRows()
        With ComboBox1
            .Clear
            .List = arrValue
            .List = Application.Transpose(arrValue)
        End With
 rst.Close
 Set rst = Nothing
 cnn.Close
 Set cnn = Nothing
     
End Sub

3./ Khi chọn thay đổi dữ liệu trong Combo thì TexBox3 sẽ hiện tên theo tương ứng.

Mã:
Private Sub ComboBox1_Change()
TextBox3 = ComboBox1.Column(1)


End Sub

*/ Nhân tiện có bài viết này chúng ta sẽ tiếp tục bàn về ADO căn bản, mong các anh chị quan tâm thảo luận thêm.
- Làm sao để lấy dữ liệu duy nhất đưa vào Combo (Có 2 cách)
- Sắp xếp dữ liệu trong Combo theo thứ tự cột đầu tiên.
Vậy có nghĩa là có thể dùng ADO lấy dữ liệu cho vào 1 mảng? (tôi thắc mắc hôm trước, nay mới có trả lời)
Ngon!
----------------------
Mà nè, cái đoạn này:
.List = Application.Transpose(arrValue)
Không nên dùng như vậy! Tốt nhất là dùng 2 vòng lập để transpose sẽ hay và nhanh hơn (đó là chưa nói đến trường hợp hàm TRANSPOSE có giới hạn sẽ bị "vỡ" với dữ liệu lớn)
----------------------
Nhân tiện, Hai Lúa hướng dẫn cách lọc Unique đi (phải thêm code gì?)
 
Nhân tiện, Hai Lúa hướng dẫn cách lọc Unique đi (phải thêm code gì?)

Lọc duy nhất như em nói ở trên thì nó có 2 cách Thầy à nhưng kết quả giống nhau (Em chưa Test về tốc độ)
Chỉ cần thay thêm chút xíu đoạn truy vấn ở trên là được.

- Cách 1: mình dùng GroupBy để lấy dữ liệu duy nhất.

Mã:
lsSQL = "select [NCC], [TEN_NCC] from [ThongTin$] group by [NCC], [TEN_NCC]"

- Cách 2: Mình dùng distinct để lấy dữ liệu duy nhất.

Mã:
lsSQL = "select distinct * from [ThongTin$]"
 
Lọc duy nhất như em nói ở trên thì nó có 2 cách Thầy à nhưng kết quả giống nhau (Em chưa Test về tốc độ)
Chỉ cần thay thêm chút xíu đoạn truy vấn ở trên là được.

- Cách 1: mình dùng GroupBy để lấy dữ liệu duy nhất.

Mã:
lsSQL = "select [NCC], [TEN_NCC] from [ThongTin$] group by [NCC], [TEN_NCC]"

- Cách 2: Mình dùng distinct để lấy dữ liệu duy nhất.

Mã:
lsSQL = "select distinct * from [ThongTin$]"
Theo kết quả thí nghiệm, tôi thấy nó lấy Unique TOÀN BỘ DỮ LIỆU chứ không riêng cột nào cả! Đúng không?
Liệu có thể lấy duy nhất cho 1 cột, các cột khác "theo" được không nhỉ?
(mấy cái ngôn ngữ này khó nhớ quá... Chắc phải thuộc lòng thôi)
 
Theo kết quả thí nghiệm, tôi thấy nó lấy Unique TOÀN BỘ DỮ LIỆU chứ không riêng cột nào cả! Đúng không?
Liệu có thể lấy duy nhất cho 1 cột, các cột khác "theo" được không nhỉ?
(mấy cái ngôn ngữ này khó nhớ quá... Chắc phải thuộc lòng thôi)

Câu hỏi này em hỏi anh HLMT hôm thứ 7 thì anh ấy nói là lấy toàn bộ sheet (bảng). Không lấy theo list.
 
Theo kết quả thí nghiệm, tôi thấy nó lấy Unique TOÀN BỘ DỮ LIỆU chứ không riêng cột nào cả! Đúng không?
Liệu có thể lấy duy nhất cho 1 cột, các cột khác "theo" được không nhỉ?
(mấy cái ngôn ngữ này khó nhớ quá... Chắc phải thuộc lòng thôi)

Hoàn toàn có thể lấy được Thầy à, ở trên là em lấy toàn bộ bảng, nếu Thầy muốn lấy cột nào thì chỉ Select cột đó là OK
Ví dụ:

Dùng GroupBy (Cột NCC):

Mã:
lsSQL = "select [NCC] from [ThongTin$] group by [NCC]"

Dùng distinct (Cột TEN_NCC):

Mã:
lsSQL = "select distinct [TEN_NCC] from [ThongTin$]"

* Thầy muốn cột nào thì chọn tiêu đề của cột đó, muốn chon hết thì thay = dấu sao "*"
 
E chưa biết dùng DTPicker nên lấy tạm của a SeaLand gán vào file thử. A HD thêm giúp e làm sao khi chọn ngày xong thì con trỏ nhảy đến CB01. Cám ơn Anh.
 

File đính kèm

Câu hỏi này em hỏi anh HLMT hôm thứ 7 thì anh ấy nói là lấy toàn bộ sheet (bảng). Không lấy theo list.

Chỉ hỏi thế thôi chứ cho dù không làm được cũng không sao!
Mục đích lấy dữ liệu bằng ADO cho vào mảng đã đạt được! Mọi thứ đã nằm trong mảng rồi, ta muốn làm gì tiếp mà chẳng được!
Ẹc... Ẹc...
 
Hoàn toàn có thể lấy được Thầy à, ở trên là em lấy toàn bộ bảng, nếu Thầy muốn lấy cột nào thì chỉ Select cột đó là OK
Ví dụ:

Dùng GroupBy (Cột NCC):

Mã:
lsSQL = "select [NCC] from [ThongTin$] group by [NCC]"

Dùng distinct (Cột TEN_NCC):

Mã:
lsSQL = "select distinct [TEN_NCC] from [ThongTin$]"

* Thầy muốn cột nào thì chọn tiêu đề của cột đó, muốn chon hết thì thay = dấu sao "*"
Ah, hổng phải vậy!
Ý tôi là vẫn lấy toàn bộ bảng tính nhưng chỉ Unique 1 cột thôi, các cột khác sẽ "ăn theo" ---> code trên là Unique tất tần tật mà
(Hôm này mới biết select * là cái gì! Cứ tưởng * là dấu nhân...)
 
Ah, hổng phải vậy!
Ý tôi là vẫn lấy toàn bộ bảng tính nhưng chỉ Unique 1 cột thôi, các cột khác sẽ "ăn theo" ---> code trên là Unique tất tần tật mà
(Hôm này mới biết select * là cái gì! Cứ tưởng * là dấu nhân...)
Phải chịu cực select cột thôi Thầy à.
*/ Ta tiếp tục nhé, với dữ liệu ở sheet Data, ta dùng GroupBy như trên để tổng hợp dữ liệu theo mã hàng, kết quả cho ra là sheet Temp.
 

File đính kèm

Em đang "tầm sư học đạo" và mới tập tọe học về ADO, tham gia trả lời trong topic này còn có nhiều điều cần phải học hỏi. Các bác nào thấy sai thì sửa giùm em để em tiến bộ hơn ạ:
Em cảm ơn ạ!


Mã:
Private Sub CommandButton3_Click()
Dim arrValue As Variant
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
Moketnoi
lsSQL = "SELECT [NCC], [Ten_NCC], Sum([so tien]) AS [Tong Tien] " & _
"FROM [data$] " & _
"GROUP BY [NCC], [Ten_NCC];"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Sheets("Temp").Range("A2").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Sheet4.Select
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Em đang "tầm sư học đạo" và mới tập tọe học về ADO, tham gia trả lời trong topic này còn có nhiều điều cần phải học hỏi. Các bác nào thấy sai thì sửa giùm em để em tiến bộ hơn ạ:
Em cảm ơn ạ!


Mã:
Private Sub CommandButton3_Click()
Dim arrValue As Variant
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
Moketnoi
lsSQL = "SELECT [NCC], [Ten_NCC], Sum([so tien]) AS [Tong Tien] " & _
"FROM [data$] " & _
"GROUP BY [NCC], [Ten_NCC];"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Sheets("Temp").Range("A2").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Sheet4.Select
End Sub
Với trường hợp trên, nếu chỉ cần lọc theo NCC thôi, kg cần theo Ten_NCC thì sửa code thế nào.
Còn có cần thiết Sum([so tien]) AS [Tong Tien]?
Tôi bỏ mà cũng chạy.
Cám ơn XuanNguyen nhiều, đúng là cao thủ ADO, chắc cũng siêu Acc.
To: HLMT
Nếu thuật toán ADO trên so với dùng Dic để lấy DM duy nhất và tính tổng thì cái nào nhanh hơn?
 
Lần chỉnh sửa cuối:
Em đang "tầm sư học đạo" và mới tập tọe học về ADO, tham gia trả lời trong topic này còn có nhiều điều cần phải học hỏi. Các bác nào thấy sai thì sửa giùm em để em tiến bộ hơn ạ:
Em cảm ơn ạ!


Mã:
Private Sub CommandButton3_Click()
Dim arrValue As Variant
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
Moketnoi
lsSQL = "SELECT [NCC], [Ten_NCC], Sum([so tien]) AS [Tong Tien] " & _
"FROM [data$] " & _
"GROUP BY [NCC], [Ten_NCC];"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Sheets("Temp").Range("A2").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Sheet4.Select
End Sub
Đúng theo yêu cầu đề bài, XN vừa làm thơ hay vừa viết code giỏi.

To: HLMT
Nếu thuật toán ADO trên so với dùng Dic để lấy DM duy nhất và tính tổng thì cái nào nhanh hơn?
Cái này em chưa thử, ở đây em muối nói về ADO thôi anh ạ.

*./ Cũng dữ liệu là sheet Data, yêu cầu lọc và tổng hợp dữ liệu với cột NCC là "XN", Kết quả đưa ra ở sheet Temp.
 
Lần chỉnh sửa cuối:
Đúng theo yêu cầu đề bài, XN vừa làm thơ hay vừa viết code giỏi.

*./ Cũng dữ liệu là sheet Data, yêu cầu lọc và tổng hợp dữ liệu với cột NCC là "XN", Kết quả đưa ra ở sheet Temp.
Cho góp vui. tham khảo ADO hay ghê, nhớ đề tài này lâu rồi nay mới xem lại. Quên tuốt.
PHP:
Sub LocADO_02()
Dim sTxT$
Dim arrValue As Variant
sTxT = "XN"
Dim lsSQL As String: Dim rst As New ADODB.Recordset
  If cnn.State = 1 Then cnn.Close
    Moketnoi
    lsSQL = "SELECT [NCC],  [Ten_NCC], [sotien] FROM [data$]"
    lsSQL = lsSQL & "where [NCC]  like '" & sTxT & "'"
    rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
    arrValue = rst.GetRows()
  With Sheet4
    .[A2].Resize(rst.RecordCount, 3) = Application.Transpose(arrValue)
  End With
 rst.Close
 Set rst = Nothing
 cnn.Close
 Set cnn = Nothing
Erase arrValue
End Sub
 
Với trường hợp trên, nếu chỉ cần lọc theo NCC thôi, kg cần theo Ten_NCC thì sửa code thế nào.
Còn có cần thiết Sum([so tien]) AS [Tong Tien]?
Tôi bỏ mà cũng chạy.
Cám ơn XuanNguyen nhiều, đúng là cao thủ ADO, chắc cũng siêu Acc.
To: HLMT
Nếu thuật toán ADO trên so với dùng Dic để lấy DM duy nhất và tính tổng thì cái nào nhanh hơn?


Hic, em hỏng phải cao thủ hay thấp thủ đâu, em phải cảm ơn GPE nhiều lắm lắm, em học được kiến thức mọi mặt, có nhiều bạn tốt, có nhiều "sư phụ", có nhiều người để mà...thương mến, hihi.
Mà em là dân HR anh ạ...

AS [Tong Tien] Không cần cũng được, cái này là gán tên cột [SumOfso tien] thành [Tong Tien], nhưng sau này mình muốn lấy tên cột?
Còn anh cần mã NCC thôi thì bỏ cái [TEN_NCC] đi
lsSQL = "SELECT [NCC], Sum([so tien]) AS [Tong Tien] "
Phần Group By chỉ cần
"GROUP BY [NCC];"
là đủ
 
Hic, em hỏng phải cao thủ hay thấp thủ đâu, em phải cảm ơn GPE nhiều lắm lắm, em học được kiến thức mọi mặt, có nhiều bạn tốt, có nhiều "sư phụ", có nhiều người để mà...thương mến, hihi.
Mà em là dân HR anh ạ...

AS [Tong Tien] Không cần cũng được, cái này là gán tên cột [SumOfso tien] thành [Tong Tien], nhưng sau này mình muốn lấy tên cột?
Còn anh cần mã NCC thôi thì bỏ cái [TEN_NCC] đi
lsSQL = "SELECT [NCC], Sum([so tien]) AS [Tong Tien] "
Phần Group By chỉ cần
"GROUP BY [NCC];"
là đủ
Bây giờ nâng cao lên nhé, vẫn dùng ADO.
Từ sh data liệt kê sang sh TMP theo từng NCC và preview (xem trước).
Nếu theo thuật toán từng làm thì như sau:
1/ Lấy DM NCC
2/ Duyệt qua NCC để lấy Data.
Kg biết ADO sẽ làm thế nào. Có thể vận dụng để InPhieuLuong.
 
Bây giờ nâng cao lên nhé, vẫn dùng ADO.
Từ sh data liệt kê sang sh TMP theo từng NCC và preview (xem trước).
Nếu theo thuật toán từng làm thì như sau:
1/ Lấy DM NCC
2/ Duyệt qua NCC để lấy Data.
Kg biết ADO sẽ làm thế nào. Có thể vận dụng để InPhieuLuong.
Hoàn toàn có thể được anh à: Lấy dữ liệu duy nhất của cột NCC đưa vào mãng, duyệt qua từng nhà cung cấp để làm điều kiện lọc.

Mã:
Private Sub cmdXem_Click()
On Error GoTo Loi
    Dim lsSQL As String, arr As Variant
    Dim r, c As Integer
    Dim rst As New ADODB.Recordset
    Unload NHAPLIEU
    If cnn.State = 1 Then cnn.Close
    Moketnoi
    With rst
        lsSQL = "SELECT distinct [NCC] from [data$]"
        .Open lsSQL, cnn, adOpenStatic, adLockReadOnly
        arr = .GetRows()
        .Close
        For c = LBound(arr, 2) To UBound(arr, 2)
            For r = LBound(arr, 1) To UBound(arr, 1)
                Sheet4.Range("A2:D65000").ClearContents
                lsSQL = "SELECT [ngay],[ncc],[Ten_Ncc],[so tien] " & _
                        "from [data$] " & _
                        "where [NCC] like'" & arr(r, c) & "'"
                        
                .Open lsSQL, cnn, adOpenStatic, adLockReadOnly
                 Sheet4.Range("A2").CopyFromRecordset rst
                .Close
                Sheet4.PrintPreview
            Next
        Next
    End With
    Set rst = Nothing
    Exit Sub
Loi:
    MsgBox Err.Description
    
End Sub
 

File đính kèm

Ta tiếp tục nhé:
Cũng dữ liệu ở bài #29 làm sao ta lọc ra dữ liệu của mã HLMT (Bao gồm cả HLMT,HLMT1...) và ngày phát sinh từ ngày 01/07/2012 đến ngày 14/07/2012.
 
PHP:
arrValue = rst.GetRows()
HK ơi, cho a hỏi, khi lấy từ recordset sang ArrValue, thì có thông số nào từ GetRows để cho ta biết tên Field (tên cột) cụ thể như NCC.
Thay vì
FieldName=rst(i).name (i=1,2,... số field.
Có thể dùng
FieldName=ArrValue(.....)
Nghĩa là Rec lấy luôn tên tiêu đề khi gán sang Arr.
Cám ơn.
 
PHP:
arrValue = rst.GetRows()
HK ơi, cho a hỏi, khi lấy từ recordset sang ArrValue, thì có thông số nào từ GetRows để cho ta biết tên Field (tên cột) cụ thể như NCC.
Thay vì
FieldName=rst(i).name (i=1,2,... số field.
Có thể dùng
FieldName=ArrValue(.....)
Nghĩa là Rec lấy luôn tên tiêu đề khi gán sang Arr.
Cám ơn.
Anh thử dùng vòng lặp duyệt qua tên trường rồi đưa tên trường đó vào mãng.
 
Ta tiếp tục nhé:
Cũng dữ liệu ở bài #29 làm sao ta lọc ra dữ liệu của mã HLMT (Bao gồm cả HLMT,HLMT1...) và ngày phát sinh từ ngày 01/07/2012 đến ngày 14/07/2012.
Anh dùng between thì được nhưng triển khai sang Ngay<=eDate and >=fDate thì báo lỗi.
Nhờ HL xem giúp.
PHP:
Sub LocADO_03()
Dim iR&, iC&
Dim sTxT$
Dim fDate$: fDate = "01/07/2012"
Dim eDate$: eDate = "14/07/2012"
Dim sArr, rArr
sTxT = "HLMT"
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
Moketnoi
lsSQL = "SELECT [NCC],  [Ten_NCC], [sotien] FROM [data$]"
lsSQL = lsSQL & "where left([NCC],4)  like '" & sTxT & "'"
'lsSQL = lsSQL & "and [Ngay] >=" & fDate & " "
'lsSQL = lsSQL & "and [Ngay] <=" & eDate & " "
lsSQL = lsSQL & "and [Ngay] BETWEEN #01/07/2012# and #14/07/2012#"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
sArr = rst.GetRows()
If rst.RecordCount Then
  ReDim rArr(1 To UBound(sArr, 2) + 1, 1 To UBound(sArr) + 1)
  For iR = 0 To UBound(sArr, 2)
    For iC = 0 To UBound(sArr)
      rArr(iR + 1, iC + 1) = sArr(iC, iR)
    Next iC
  Next iR
Else
  Exit Sub
End If
With Sheet4
  .[A2].Resize(1000, 3).ClearContents
  .[A2].Resize(rst.RecordCount, 3) = rArr
End With
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
Erase sArr, rArr
End Sub
 
đúng rồi anh à, phần sotien anh tham chiếu bị sai: phải là [so tien]
 
đúng rồi anh à, phần sotien anh tham chiếu bị sai: phải là [so tien]
Không phải vậy. Đã sử field name sotien rồi.
Muốn thay thế dòng between mà cứ báo lỗi EOF...
HL test giúp. Bỏ dòng between và thay dòng and >....
PHP:
Sub LocADO_03()
Dim iR&, iC&
Dim sTxT$
Dim fDate$: fDate = "01/07/2012"
Dim eDate$: eDate = "14/07/2012"
Dim sArr, rArr
sTxT = "HLMT"
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
Moketnoi
lsSQL = "SELECT [NCC],  [Ten_NCC], [sotien] FROM [data$]"
lsSQL = lsSQL & "where left([NCC],4)  like '" & sTxT & "'"
lsSQL = lsSQL & "and [Ngay] >=" & fDate & " "
lsSQL = lsSQL & "and [Ngay] <=" & eDate & " "
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
sArr = rst.GetRows()
If rst.RecordCount Then
  ReDim rArr(1 To UBound(sArr, 2) + 1, 1 To UBound(sArr) + 1)
  For iR = 0 To UBound(sArr, 2)
    For iC = 0 To UBound(sArr)
      rArr(iR + 1, iC + 1) = sArr(iC, iR)
    Next iC
  Next iR
Else
  Exit Sub
End If
With Sheet4
  .[A2].Resize(1000, 3).ClearContents
  .[A2].Resize(rst.RecordCount, 3) = rArr
End With
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
ErasesArr, rArr
End Sub
Hình như nó sai ở chỗ kiểu ngày mà chưa tìm ra.
 
Lần chỉnh sửa cuối:
Không phải vậy. Đã sử field name sotien rồi.
Muốn thay thế dòng between mà cứ báo lỗi EOF...
HL test giúp. Bỏ dòng between và thay dòng and >....
PHP:
Sub LocADO_03()
Dim iR&, iC&
Dim sTxT$
Dim fDate$: fDate = "01/07/2012"
Dim eDate$: eDate = "14/07/2012"
Dim sArr, rArr
sTxT = "HLMT"
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
Moketnoi
lsSQL = "SELECT [NCC],  [Ten_NCC], [sotien] FROM [data$]"
lsSQL = lsSQL & "where left([NCC],4)  like '" & sTxT & "'"
lsSQL = lsSQL & "and [Ngay] >=" & fDate & " "
lsSQL = lsSQL & "and [Ngay] <=" & eDate & " "
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
sArr = rst.GetRows()
If rst.RecordCount Then
  ReDim rArr(1 To UBound(sArr, 2) + 1, 1 To UBound(sArr) + 1)
  For iR = 0 To UBound(sArr, 2)
    For iC = 0 To UBound(sArr)
      rArr(iR + 1, iC + 1) = sArr(iC, iR)
    Next iC
  Next iR
Else
  Exit Sub
End If
With Sheet4
  .[A2].Resize(1000, 3).ClearContents
  .[A2].Resize(rst.RecordCount, 3) = rArr
End With
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
ErasesArr, rArr
End Sub


Cho em "bon chen" tý ạ.

Anh cho thêm dấu # vào điều kiện ngày:

lsSQL = lsSQL & "and [Ngay] >=#" & fDate & "#"
lsSQL = lsSQL & "and [Ngay] <=#" & eDate & "#"
 
Cho em "bon chen" tý ạ.

Anh cho thêm dấu # vào điều kiện ngày:

lsSQL = lsSQL & "and [Ngay] >=#" & fDate & "#"
lsSQL = lsSQL & "and [Ngay] <=#" & eDate & "#"
XN nhanh tay thiệt, chưa kịp trả lời là đã có đáp án.

Ta tiếp tục:
*./ Cũng dữ liệu trên làm sao ta lấy được 2 số tiền là cao nhất.
 
Cho em "bon chen" tý ạ.

Anh cho thêm dấu # vào điều kiện ngày:

lsSQL = lsSQL & "and [Ngay] >=#" & fDate & "#"
lsSQL = lsSQL & "and [Ngay] <=#" & eDate & "#"
Cám ơn Xuân nhiều. OK rồi.
Cái vụ SQL này nhức đầu mấy cái dấu,vì kg qua bài bản nên làm kg bài bản.
Muốn làm để triển khai cho dễ.
 
Anh thử Select Top 2 xem coi được hong nhé.
Nhưng nếu top 2 sotien không thỏa dk là HLMT, thì nó kg chịu
VD: Max là 100.000 và 111.000 nhưng là XN
PHP:
Sub LocADO_04()
Dim ST01, ST02
Dim iR&, iC&
Dim sTxT$
Dim fDate$: fDate = "01/07/2012"
Dim eDate$: eDate = "14/07/2012"
Dim sArr, rArr
sTxT = "HLMT"
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
With Sheet4
  .[A2].Resize(1000, 3).ClearContents
End With
Moketnoi
lsSQL = "SELECT [NCC],  [Ten_NCC], [sotien] FROM [data$]"
lsSQL = lsSQL & "where left([NCC],4)  like '" & sTxT & "'"
lsSQL = lsSQL & "and [Ngay] >=#" & fDate & "#"
lsSQL = lsSQL & "and [Ngay] <=#" & eDate & "#"
lsSQL = lsSQL & "and sotien in (select top 2 sotien from [data$] order by sotien DESC)"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
If rst.RecordCount Then
  sArr = rst.GetRows()
  ReDim rArr(1 To UBound(sArr, 2) + 1, 1 To UBound(sArr) + 1)
  For iR = 0 To UBound(sArr, 2)
    For iC = 0 To UBound(sArr)
      rArr(iR + 1, iC + 1) = sArr(iC, iR)
    Next iC
  Next iR
Else
  Exit Sub
End If
With Sheet4
  .[A2].Resize(rst.RecordCount, 3) = rArr
End With
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
Erase sArr, rArr
End Sub
 
Nhưng nếu top 2 sotien không thỏa dk là HLMT, thì nó kg chịu
VD: Max là 100.000 và 111.000 nhưng là XN
PHP:
Sub LocADO_04()
Dim ST01, ST02
Dim iR&, iC&
Dim sTxT$
Dim fDate$: fDate = "01/07/2012"
Dim eDate$: eDate = "14/07/2012"
Dim sArr, rArr
sTxT = "HLMT"
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
With Sheet4
  .[A2].Resize(1000, 3).ClearContents
End With
Moketnoi
lsSQL = "SELECT [NCC],  [Ten_NCC], [sotien] FROM [data$]"
lsSQL = lsSQL & "where left([NCC],4)  like '" & sTxT & "'"
lsSQL = lsSQL & "and [Ngay] >=#" & fDate & "#"
lsSQL = lsSQL & "and [Ngay] <=#" & eDate & "#"
lsSQL = lsSQL & "and sotien in (select top 2 sotien from [data$] order by sotien DESC)"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
If rst.RecordCount Then
  sArr = rst.GetRows()
  ReDim rArr(1 To UBound(sArr, 2) + 1, 1 To UBound(sArr) + 1)
  For iR = 0 To UBound(sArr, 2)
    For iC = 0 To UBound(sArr)
      rArr(iR + 1, iC + 1) = sArr(iC, iR)
    Next iC
  Next iR
Else
  Exit Sub
End If
With Sheet4
  .[A2].Resize(rst.RecordCount, 3) = rArr
End With
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
Erase sArr, rArr
End Sub


Anh ra kết quả không như mong đợi chắc có lẽ là do anh select top 2 của toàn bộ dữ liệu trong bảng data, mà đề bài yêu cầu là chỉ lấy HLMT, em nghĩ anh thử thêm điều kiện lọc là HLMT vào cái sub query chạy xem sao.
 
Anh ra kết quả không như mong đợi chắc có lẽ là do anh select top 2 của toàn bộ dữ liệu trong bảng data, mà đề bài yêu cầu là chỉ lấy HLMT, em nghĩ anh thử thêm điều kiện lọc là HLMT vào cái sub query chạy xem sao.
Tìm ra rồi, select top và lồng thêm where.
Phức tạp quá
Nếu xử lý arr thì phải duyệt qua arr để lấy top 2.
PHP:
Sub LocADO_05()
Dim iR&, iC&
Dim sTxT$
Dim fDate$: fDate = "01/07/2012"
Dim eDate$: eDate = "14/07/2012"
Dim sArr, rArr
sTxT = "HLMT"
Dim lsSQL As String: Dim rst As New ADODB.Recordset
If cnn.State = 1 Then cnn.Close
With Sheet4
  .[A2].Resize(1000, 3).ClearContents
End With
Moketnoi
lsSQL = "SELECT [NCC],  [Ten_NCC], [sotien] FROM [data$]"
lsSQL = lsSQL & "where sotien in (select top 2 sotien from [data$]"
lsSQL = lsSQL & "where left([NCC],4)  like '" & sTxT & "'"
lsSQL = lsSQL & "and [Ngay] >=#" & fDate & "#"
lsSQL = lsSQL & "and [Ngay] <=#" & eDate & "#"
lsSQL = lsSQL & "order by sotien DESC)"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
If rst.RecordCount Then
  sArr = rst.GetRows()
  ReDim rArr(1 To UBound(sArr, 2) + 1, 1 To UBound(sArr) + 1)
  For iR = 0 To UBound(sArr, 2)
    For iC = 0 To UBound(sArr)
      rArr(iR + 1, iC + 1) = sArr(iC, iR)
    Next iC
  Next iR
Else
  Exit Sub
End If
With Sheet4
  .[A2].Resize(rst.RecordCount, 3) = rArr
End With
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
Erase sArr, rArr
End Sub
Học SQL này vui quá. HL cho đề tài next đi.
 
Tìm ra rồi, select top và lồng thêm where.
Phức tạp quá
Nếu xử lý arr thì phải duyệt qua arr để lấy top 2.

Học SQL này vui quá. HL cho đề tài next đi.

Anh ThuNghi ơi, chắc là em tạm dừng đến đây, chiều nay em xin quay về bài 1 vì bài 1 chưa giải quyết xong, thắc mắc của Tùng là nhập liệu (Em sẽ hướng dẫn nhập liệu = ADO), định dạng số thì anh giải quyết xong, còn cái TextBox ngày nữa Tùng muốn không dùng DTPicker. Khi giải quyết xong các vấn đề của Tùng mình tiếp tục nha anh. Tốc độ chậm chậm thôi anh à, anh chạy nhanh quá, em chóng hết cả mặt...
 
To anh Thunghi:
Là cái điều kiện lọc của anh hơi dài, có thể rút gọn mà không cần dùng hàm left([NCC],4)

Tùng sắp ....bực mình rồi anh ạ! Không theo bài 1 là bạn í vào đây, ...ăn vạ đó.!!! Hihi...
Em cũng cần học hỏi thêm nhiều vấn đề nữa ạ!
 
Lần chỉnh sửa cuối:
... còn cái TextBox ngày nữa Tùng muốn không dùng DTPicker. Khi giải quyết xong các vấn đề của Tùng mình tiếp tục nha anh. Tốc độ chậm chậm thôi anh à, anh chạy nhanh quá, em chóng hết cả mặt...
Nhập ngày trên form có nhiều cách, lâu rồi OB cũng đã làm 1 form nhập ngày. Hay cũng có bài làm form nhập ngày theo dạng 3 txtBox dd/mm/yyyy và ghép lại nhưng tất cả đều có thể nhập sai cả và cũng phức tạp. Nếu muốn nhập trên form mà kg nghiên cứu DTPicker thì dùng cách khác càng khó hơn.
 

File đính kèm

Nhập ngày trên form có nhiều cách, lâu rồi OB cũng đã làm 1 form nhập ngày. Hay cũng có bài làm form nhập ngày theo dạng 3 txtBox dd/mm/yyyy và ghép lại nhưng tất cả đều có thể nhập sai cả và cũng phức tạp. Nếu muốn nhập trên form mà kg nghiên cứu DTPicker thì dùng cách khác càng khó hơn.
Theo em nếu không muốn dùng DTPicker thì em dùng hàm để thay đổi định dạng của hệ thống, ai muốn nhập kiểu nào thì chọn kiểu ấy. Nếu Tùng theo cách này thì ta tiếp tục.
 
Theo em nếu không muốn dùng DTPicker thì em dùng hàm để thay đổi định dạng của hệ thống, ai muốn nhập kiểu nào thì chọn kiểu ấy. Nếu Tùng theo cách này thì ta tiếp tục.

Đúng là em không rành lắm cái này, tuy nhiên thấy cái DTPicker thì bất tiện vì không phải máy nào cũng "tự nhiên" mà chạy được. còn cái cách thay đổi ngày hệ thống thì sao?? nó có ảnh hưởng đến chương trình (cụ thể là 1 phần mềm) nào đó đang cùng chạy trên máy tính không?.
 
Đúng là em không rành lắm cái này, tuy nhiên thấy cái DTPicker thì bất tiện vì không phải máy nào cũng "tự nhiên" mà chạy được. còn cái cách thay đổi ngày hệ thống thì sao?? nó có ảnh hưởng đến chương trình (cụ thể là 1 phần mềm) nào đó đang cùng chạy trên máy tính không?.
Muốn cái bất tiện trở thành tiện cũng không phải không có cách:
- Viết 1 chương trình (VB chẳng hạn)
- Mang file mình + file chương trình sang máy khác và chạy file chương trình
- Chương trình sẽ dò tìm xem trong máy cái thằng DTPicker đã cài chưa. Nếu chưa cài, nó sẽ tiến hành cài đặt (cũng khá dễ bằng cách copy mscomct2.ocx vào thư mục System32 rồi đăng ký nó)
- Cuối cùng khởi động file Excel là cứ thế vi vu, chẳng lo gì vụ báo lỗi
 
Đúng là em không rành lắm cái này, tuy nhiên thấy cái DTPicker thì bất tiện vì không phải máy nào cũng "tự nhiên" mà chạy được. còn cái cách thay đổi ngày hệ thống thì sao?? nó có ảnh hưởng đến chương trình (cụ thể là 1 phần mềm) nào đó đang cùng chạy trên máy tính không?.
Chắc chắn sẽ ảnh hưởng nếu như phần mềm nào đó có định dạng ngày tháng không cùng với định dạng của người chọn kiểu nhập.
Ý định khác phục là vầy, khi mở form, mình lấy kiểu định dạng của hệ thống là gì rồi lưu nó vào 1 biến nào đó, người dùng chọn kiểu nhập nào thì khi thoát khỏi form thì nó sẽ reset lại theo như định dạng ban đầu. Tuy nhiên sẽ ảnh hưởng đến phần mềm khác đang chạy song song.
Nếu thấy cách này không được thì Tùng nên chọn cách của anh OKBab, hoặc phải sử dụng DTPicker.
 
Muốn cái bất tiện trở thành tiện cũng không phải không có cách:
- Viết 1 chương trình (VB chẳng hạn)
- Mang file mình + file chương trình sang máy khác và chạy file chương trình
- Chương trình sẽ dò tìm xem trong máy cái thằng DTPicker đã cài chưa. Nếu chưa cài, nó sẽ tiến hành cài đặt (cũng khá dễ bằng cách copy mscomct2.ocx vào thư mục System32 rồi đăng ký nó)
- Cuối cùng khởi động file Excel là cứ thế vi vu, chẳng lo gì vụ báo lỗi
Tiện đây NDU hd cụ thể cácch tạo DTPicker giúp.
Tôi cũng đã copy ocx và đã run rồi nhưng trên form cũng kg thể hiện DTPicker. Chỉ copy từ file có sẵn sang thì dùng được.
Và NDU hd dùng cho Ex 2010 luôn nhé.
Cám ơn nhiều.
Có bài mở 1 form mới và import sang mà tìm hoài không thấy link đó.
Tìm mãi mới thấy link, bài NDU nhiều quá, tìm kg thấy từ khóa NDU phải chuyển sang ...1066.
http://www.giaiphapexcel.com/forum/...t-tình-trạng-Additional-Controls-mất-tác-dụng
.. OK rồi
 
Lần chỉnh sửa cuối:
Đúng là em không rành lắm cái này, tuy nhiên thấy cái DTPicker thì bất tiện vì không phải máy nào cũng "tự nhiên" mà chạy được. còn cái cách thay đổi ngày hệ thống thì sao?? nó có ảnh hưởng đến chương trình (cụ thể là 1 phần mềm) nào đó đang cùng chạy trên máy tính không?.

Sao lại thay đổi ngày hệ thống? Kể cả thay đổi thiết lập hiển thị, nhập ngày tháng cũng thế. Phần mềm của mình sang máy người khác chạy thì phải lấy thiết lập của người ta chứ. Máy của người ta, người ta là chủ, thiết lập của người ta sao lại tự ý đổi?
Theo tôi bạn qui định cho người dùng là phải nhập ngày tháng theo mẫu: dd/mm/yyyy (hoặc tăng thêm vài mẫu). Tất nhiên phải kiểm tra dữ liệu được nhập và bắt nhập lại nếu sai. vd. 42/11/2012 là sai. Trên shett định dạng các ô là DATE. Còn chuyện Excel hiển thị thế nào thì tùy thiết lập tron CP. Người nhập vào vd. 21/08/2012, xuống sheet trên máy của bạn thì thấy 21/08/2012, mang sang máy khác thì lại thấy 2012-08-21. Tất cả đều là cùng một ngày. Như em Hà My hôm nay tô môi, mặc váy đầm thì không còn là Hà My mắt nâu nữa à?
DTPicker có ưu điểm là bạn chọn chứ không gõ, mà không gõ thì sẽ không bị gõ sai.
 
Sao lại thay đổi ngày hệ thống? Kể cả thay đổi thiết lập hiển thị, nhập ngày tháng cũng thế. Phần mềm của mình sang máy người khác chạy thì phải lấy thiết lập của người ta chứ. Máy của người ta, người ta là chủ, thiết lập của người ta sao lại tự ý đổi?
Theo tôi bạn qui định cho người dùng là phải nhập ngày tháng theo mẫu: dd/mm/yyyy (hoặc tăng thêm vài mẫu). Tất nhiên phải kiểm tra dữ liệu được nhập và bắt nhập lại nếu sai. vd. 42/11/2012 là sai. Trên shett định dạng các ô là DATE. Còn chuyện Excel hiển thị thế nào thì tùy thiết lập tron CP. Người nhập vào vd. 21/08/2012, xuống sheet trên máy của bạn thì thấy 21/08/2012, mang sang máy khác thì lại thấy 2012-08-21. Tất cả đều là cùng một ngày. Như em Hà My hôm nay tô môi, mặc váy đầm thì không còn là Hà My mắt nâu nữa à?
DTPicker có ưu điểm là bạn chọn chứ không gõ, mà không gõ thì sẽ không bị gõ sai.

Hihi.. như đã nói từ đầu là em chằng có rành cái món VB này nên --> hỏng biết cái nào tiện và cái nào không tiện cũng như cách thức thực hiện đó nên hay hỏi để các anh chị giải thích từng cách --> em có sự lựa chọn tiện cho em sử dụng nhất.

Rất nhiều cách đưa ra và mỗi cách có ưu điểm và nhược điểm và tất nhiên ngoải việc chọn được cách "phù hợp nhất với kiến thức sử dụng của mình thì bản thân những ai chưa biết như em cũng có điều kiện học hỏi thêm, biết thêm nhiều cách khác nhau.

Đó cũng là ý tưởng và lý do tại sao tên của topic là [h=1]Nhờ hướng dẫn (gợi ý) giải quyết vấn đề bằng VBA[/h]
Mong rằng tiếp tục nhận được nhiều hơn sự giúp đỡ và chỉ dẫn từ tất cả các anh chị.
 
Đúng là em không rành lắm cái này, tuy nhiên thấy cái DTPicker thì bất tiện vì không phải máy nào cũng "tự nhiên" mà chạy được. còn cái cách thay đổi ngày hệ thống thì sao?? nó có ảnh hưởng đến chương trình (cụ thể là 1 phần mềm) nào đó đang cùng chạy trên máy tính không?.

Vào bài này của tên Ếch Xanh nè, có form tự tạo tuyệt vời hơn cả cái DTPicker đấy (có cả lịch âm dương mới ghê).

http://www.giaiphapexcel.com/forum/...t-caption-cho-nhiều-Label&p=242423#post242423
 
Thôi thì bây giờ anh làm định dạng bình thường, sau này Tùng giỏi lên rồi biến chế nhé.

1. Định dạng TextBox

Mã:
Private Sub TextBox1_AfterUpdate() 
TextBox1 = Format(TextBox1, "dd/mm/yyyy")
 
End Sub

2. Đưa dữ liệu vào sheet = ADO

Mã:
Private Sub CommandButton1_Click()
Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
rst.Open "SELECT * FROM [data$]", cnn, 1, 3
 With rst
     .AddNew
        ![Ngay] = TextBox1
        ![NCC] = ComboBox1
        ![Ten_NCC] = TextBox3
        ![So Tien] = TextBox4
        ![Dien Giai] = TextBox5
        .Update
       .Close
End With
Set rst = Nothing


End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
2. Đưa dữ liệu vào sheet = ADO

Mã:
Private Sub CommandButton1_Click()
Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
rst.Open "SELECT * FROM [data$]", cnn, 1, 3
 With rst
     .AddNew
        ![Ngay] = TextBox1
        ![NCC] = ComboBox1
        ![Ten_NCC] = TextBox3
        ![So Tien] = TextBox4
        ![Dien Giai] = TextBox5
        .Update
       .Close
End With
Set rst = Nothing


End Sub

Code trên mà không bẫy lỗi rỗng cho các TextBox hay Combobox thì sẽ phát sinh lỗi đấy nhé bạn Hai Lúa.
 
Hì, cũng đang học ADO, chưa xem được nhiều, nhưng có 1 chỗ thấy chưa hợp lý: khi xem NCC thì lại đóng form, cho nên khi đóng PrintPreview trở lại form thì thông tin đã nhập trước đó bị mất. Đề nghị thay lệnh:

unload NHAPLIEU bằng lệnh NHAPLIEU.Hide

trong Private Sub cmdXem_Click()
 
Chắc chắn sẽ lỗi nếu như không nhập đủ thông tin điều mà em biết chứ, ta có thể dùng hàm IIF để xử lổi này. Mình chỉ đưa ví dụ về cách nhập liệu 1 cách căn bản cho người mới học dể hiểu. Sẽ còn 1 cách khong cần xử lí lổ niày
 
Lần chỉnh sửa cuối:
Em thêm xử lý lỗi TextBox trống như sau:

Mã:
Private Sub CommandButton1_Click()
Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
rst.Open "SELECT * FROM [data$]", cnn, 1, 3
 
With rst
     .AddNew
        ![Ngay] = IIf(IsDate(TextBox1) = False, Format(Date, "dd/mm/yyyy"), TextBox1)
        ![NCC] = IIf(IsNull(ComboBox1), "", ComboBox1)
        ![Ten_NCC] = IIf(TextBox3 = "", "", TextBox3)
        ![So Tien] = IIf(IsNumeric(TextBox4) = True, TextBox4, 0)
        ![Dien Giai] = IIf(Len(TextBox5) = 0, "", TextBox3)
        .Update
       .Close
End With
Set rst = Nothing
 
End Sub

Ngoài ra code nhập liệu này cần phải them 1 code xóa trống các TextBox sau khi nhập liệu vào sheet xong.
 
Em thêm xử lý lỗi TextBox trống như sau:

Mã:
Private Sub CommandButton1_Click()
Dim rst As New ADODB.Recordset
If cnn.State <> 1 Then Moketnoi
rst.Open "SELECT * FROM [data$]", cnn, 1, 3
 
With rst
     .AddNew
        ![Ngay] = IIf(IsDate(TextBox1) = False, Format(Date, "dd/mm/yyyy"), TextBox1)
        ![NCC] = IIf(IsNull(ComboBox1), "", ComboBox1)
        ![Ten_NCC] = IIf(TextBox3 = "", "", TextBox3)
        ![So Tien] = IIf(IsNumeric(TextBox4) = True, TextBox4, 0)
        ![Dien Giai] = IIf(Len(TextBox5) = 0, "", TextBox3)
        .Update
       .Close
End With
Set rst = Nothing
 
End Sub

Ngoài ra code nhập liệu này cần phải them 1 code xóa trống các TextBox sau khi nhập liệu vào sheet xong.
Đã dùng form thì xử lý trên form trước khi OK, ai lại làm ngược, OK xong mới xử lý rec.
 
Đã dùng form thì xử lý trên form trước khi OK, ai lại làm ngược, OK xong mới xử lý rec.
Vậy thì bắt lỗi ngay sự kiện AfterUpdate của các controls, nhập không phải ngày, không phải số, chi chạy code nhập liệu bắt lỗi ô trống. Nhưng nhiều khi người ta không cần nhập đủ thông tin anh à... Thôi thì tùy người sử dụng vậy.
 
Sorry Tùng, hôm nay mới đọc được topic này.

Gởi các bác đang giúp Tùng, he he, biết là nói nhiều mất vui nhưng các bác tập trung giúp em tùng hiểu được cách làm trước đừng nóng vội nhảy sang ADO, có quá nhiều thông tin cần phải tìm hiểu. Đặc biệt là ADO cũng có quá nhiều chuyện hiểu.

Em thấy đây là các vấn đề rất hay vì nó toàn chuyện của bất kỳ người mới bắt đầu học VBA nào cũng gặp phải.

- Vấn đề về ngày và DTPicker: Tùng không nên quá cầu toàn về chuyện này em nắm bắt được bao nhiêu thì nắm.
- Vấn đề combobox: hãy suy nghĩ về việc làm sao đưa giá trị vào nó và lấy giá trị ra chắc là hiểu rồi phải không
- Ô số và định dạng số: cái này cũng có nhiều vấn đề chứ không chỉ là chuyện là định dạng đâu.

Hãy đọc code của bác Sealand trước đi nhé. Không quá dài, giải quyết được vấn đề. Hiểu đi rồi hỏi thêm.

OverAC
 
E chưa biết dùng DTPicker nên lấy tạm của a SeaLand gán vào file thử. A HD thêm giúp e làm sao khi chọn ngày xong thì con trỏ nhảy đến CB01. Cám ơn Anh.

Vì người dùng có thói quen sau khi nhập xong thường nhấn Enter, nhưng DTPicker không hỗ trợ. Vậy là ta bắt luôn phím đó ở sự kiện Keydown như sau:

Mã:
Private Sub DTPicker_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = 13 Then
KeyCode = 0
SendKeys ("{TAB}")
End If
End Sub
 
@ Sealand

Chạy file của Anh nó báo lỗi

PHP:
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox4 = Format(Me.TextBox4, "#,##0")
End Sub

Cho hỏi nguyên nhân ở đâu ah.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Lỗi nó báo sao vậy Tùng?

Thử cái này xem sao?
PHP:
Private Sub TextBox4_Change()
Me.TextBox4 = Format(Me.TextBox4, "#,##0")
End Sub
 
Lần chỉnh sửa cuối:
Anh Bình ơi, code của anh đặt ở sự kiện change là không ổn rồi vì mỗi thay đổi hàm Format đều chuyển giá trị Textbox thành chuỗi. Khi ta thêm số và nó format là lỗi ngay anh ạ.


P/s:Xin lỗi, mình nhầm trường hợp có định dạng số thập phân.

Chạy file của Anh nó báo lỗi

Đáng lẽ bạn phải báo lỗi ra sao mới biết đường tìm chớ.
 
Lần chỉnh sửa cuối:
Anh Bình ơi, code của anh đặt ở sự kiện change là không ổn rồi vì mỗi thay đổi hàm Format đều chuyển giá trị Textbox thành chuỗi. Khi ta thêm số và nó format là lỗi ngay anh ạ.
Em chạy không lỗi anh ơi. không biết có phải do chạy bằng Excel2010?

Mà nếu có lỗi như anh nói, thì: Me.TextBox4 = Format(Cdbl(Me.TextBox4), "#,##0")
 
Minh viết không chuẩn, không phải lỗi về code mà lỗi về nhập dữ liệu. Khi nhập con trỏ luôn ở phần thập phân rất khó nhập phần nguyên anh Bình à.
Thực sự mình cũng chưa tìm ra cách để tạo ô nhập số mãn ý. Đây là 1 nhu cầu của dân Kế toán tránh sai sót khi nhập dữ liệu. Thôi thì từng vấn đề trên form theo yêu cầu của Tùng ta nên lần lượt tranh luận giải quyết tốt để vừa giúp Tùng vừa học tập luôn.Mong mọi người cởi mở tham gia.
Vậy yêu cầu của việc tạo ô nhận số như sau:
-Chỉ nhận các số từ 0-9,-(âm). Nếu nhập không hợp lệ phát tiếng Beep.
-Định dạng: có phân nhóm hàng ngàn và có 2 số thập phân.
-Khi nhập dữ liệu không phải dùng chuột hay phím di chuyển.
 
Minh viết không chuẩn, không phải lỗi về code mà lỗi về nhập dữ liệu. Khi nhập con trỏ luôn ở phần thập phân rất khó nhập phần nguyên anh Bình à.

Em xin "cố chấp" mà sửa code vậy :)

Mã:
Private Sub TextBox4_change()
Dim DecSpe, ThoSpe
DecSpe = Application.DecimalSeparator
ThoSpe = Application.ThousandsSeparator

If InStr(1, Me.TextBox4, DecSpe) Then
    Me.TextBox4 = Format(Me.TextBox4, "#" & ThoSpe & "###" & DecSpe & "########")
Else
    Me.TextBox4 = Format(Me.TextBox4, "#" & ThoSpe & "##0")
End If

End Sub
 
Minh viết không chuẩn, không phải lỗi về code mà lỗi về nhập dữ liệu. Khi nhập con trỏ luôn ở phần thập phân rất khó nhập phần nguyên anh Bình à.
Thực sự mình cũng chưa tìm ra cách để tạo ô nhập số mãn ý. Đây là 1 nhu cầu của dân Kế toán tránh sai sót khi nhập dữ liệu. Thôi thì từng vấn đề trên form theo yêu cầu của Tùng ta nên lần lượt tranh luận giải quyết tốt để vừa giúp Tùng vừa học tập luôn.Mong mọi người cởi mở tham gia.
Vậy yêu cầu của việc tạo ô nhận số như sau:
-Chỉ nhận các số từ 0-9,-(âm). Nếu nhập không hợp lệ phát tiếng Beep.
-Định dạng: có phân nhóm hàng ngàn và có 2 số thập phân.
-Khi nhập dữ liệu không phải dùng chuột hay phím di chuyển.

Theo yêu cầu, Em tạo 1 sub kiểm số như sau (Cho nhập số và dấu -):
Mã:
 Sub KiemSo()
If TypeName(Me.ActiveControl) = "TextBox" Then
    With Me.ActiveControl
        If Not IsNumeric(.Value) And .Value <> vbNullString And .Value <> "-" Then
            Beep
            MsgBox "Xin loi, ban phai nhap so"
            .Value = vbNullString
        End If
    End With
End If
End Sub
Trong TextBox khi nhập liệu mình kiểm số như sau:
Mã:
Private Sub TextBox4_Change()
KiemSo
End Sub
Định dạng lại số sau khi nhập liệu vào TextBox
Mã:
Private Sub TextBox4_AfterUpdate()
TextBox4.Value = Format(TextBox4.Value, "#,##0.00")
End Sub


File đính kèm
 

File đính kèm

@ Sealand

Chạy file của Anh nó báo lỗi

PHP:
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox4 = Format(Me.TextBox4, "#,##0")
End Sub

Cho hỏi nguyên nhân ở đâu ah.
Vấn đề là Tùng đã nhập cái gì vào TB4 đó. và báo lỗi thế nào.
Còn chỉ cho phép nhập số vào thì dùng
PHP:
Private Sub TextBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
  Case Asc("0") To Asc("9"), Asc("-")
  Case Asc(".")
    If InStr(1, Me.TextBox4.Text, ".") > 0 Then
      KeyAscii = 0
    End If
  Case Else
    KeyAscii = 0
End Select

End Sub
Cái này copy của Bác Duyệt từ lâu lắm rồi. Còn caulacbovb thì nhiều lắm
PHP:
Private Sub TextBox4_KeyPress(KeyAscii  As Integer)
 If InStr("1234567890" + Chr$(vbKeyBack), Chr$(KeyAscii)) = 0 Then
  KeyAscii = 0
  Beep
 End If
End Sub
hay
PHP:
If IsNumeric(Chr(KeyAscii)) <> True Then KeyAscii = 0
 
Không biết chủ topic đã "tiếp chiêu" đến đâu rồi mà lặng mất vậy ta?
- Đưa dữ liệu vào Combo.
- Định dạng ngày, số
- Nhập liệu vào sheet.
- Xóa trống các Controls sau khi nhập.
 
Lần chỉnh sửa cuối:
/_ắm cha con khó lấy chồng đó mà!

HaiDuong0.jpg
HaiDuong0.jpg
HaiDuong0.jpg
HaiDuong0.jpg
HaiDuong0.jpg
 
Không biết chủ topic đã "tiếp chiêu" đến đâu rồi mà lặng mất vậy ta?
- Đưa dữ liệu vào Combo.
- Định dạng ngày, số
- Nhập liệu vào sheet.
- Xóa trống các Controls sau khi nhập.

Báo cáo các Thầy, tối nay em sẽ cho ra mắt sản phẩm đầu tay, (phải coi ngày nữa chứ).
 
Để xem chú Tùng "mần ăn" làm sao với "đứa con đầu lòng" đây!

Hai Lúa Miền Tây đã viết:
Không biết chủ topic đã "tiếp chiêu" đến đâu rồi mà lặng mất vậy ta?
- Đưa dữ liệu vào Combo.
- Định dạng ngày, số
- Nhập liệu vào sheet.
- Xóa trống các Controls sau khi nhập.

Hôm nay có độ nhậu nhưng không quên nhiệm vụ là phải học VBA (cho dù biết mới chút chút).

Mong rằng các Anh Chị chỉ bảo dạy thêm, có lẽ đây là bài đầu tiên trong đời tính tới thời điểm này em post bài có chút "mùi" VBA.
 

File đính kèm

Hay nhất cái này. he he.
Mã:
Sub TenConTrol()
Dim ctr As Control
For Each ctr In NHAPLIEU.Controls
   If TypeOf ctr Is MSForms.TextBox Or TypeOf ctr Is MSForms.ComboBox Then
  ctr.Value = ""
   End If
Next
End Sub
 
Hôm nay có độ nhậu nhưng không quên nhiệm vụ là phải học VBA (cho dù biết mới chút chút).

Mong rằng các Anh Chị chỉ bảo dạy thêm, có lẽ đây là bài đầu tiên trong đời tính tới thời điểm này em post bài có chút "mùi" VBA.
Lần đầu "làm chuyện ấy" như thế là ngon rồi
Ẹc... Ẹc...
Lưu ý chổ này:
Mã:
.Range("E" & LastRowData) = TextBox4
Kết quả số tiền ra toàn là Text, hổng phải Number
Và:
Mã:
TextBox4 = Format(TextBox4, "#,##0")
Hổng phải máy nào cũng dùng dấu phẩy làm dấu phân cách ngàn đâu nha!
Cố gắng lần sau "làm chuyện ấy" có kinh nghiệm hơn ha!
 
Hay nhất cái này. he he.
Mã:
Sub TenConTrol()
Dim ctr As Control
For Each ctr In NHAPLIEU.Controls
   If TypeOf ctr Is MSForms.TextBox Or TypeOf ctr Is MSForms.ComboBox Then
  ctr.Value = ""
   End If
Next
End Sub
Tôi thử dùng for each trên để gán dữ liệu vào 1Arr trước khi gán ="".
Không biết thuật toán trên liệu có dư lắm.
PHP:
Option Explicit
Dim i&, iPos&, LastRow&
Dim sTxt$
Dim Dic As Object
Dim ArrTmp, Arr(1 To 5)

Private Sub ComboNCC_Enter()
SendKeys ("%{DOWN}")
End Sub

Private Sub TextBox1_AfterUpdate()
TextBox1 = Format(TextBox1, "dd/mm/yyyy")
End Sub
Private Sub UserForm_Initialize()
ArrTmp = Array("TextBox1", "ComboNCC", "TextBox3", "TextBox5", "TextBox4")
Set Dic = CreateObject("Scripting.Dictionary")
For i = LBound(ArrTmp) To UBound(ArrTmp)
  Dic.Add ArrTmp(i), i + 1
Next i
LastRow = Sheet2.Range("A65000").End(xlUp).Row
ComboNCC.RowSource = "'" & Sheet2.Name & "'!A2:b" & LastRow
End Sub
Private Sub ComboNCC_afterUpdate()
TextBox3 = ComboNCC.Column(1)
End Sub
Private Sub TextBox4_Change()
TextBox4 = Format(TextBox4, "#,##0")
End Sub
Private Sub CommandButton1_Click()
LastRow = Sheet3.Range("a50000").End(xlUp).Row + 1
LayConTrol
With Sheets("Data")
  .Cells(LastRow, 1).Resize(, 5) = Arr
End With
Erase Arr
End Sub
Sub LayConTrol()
i = 0
Dim Ctr As Control
For Each Ctr In NHAPLIEU.Controls
  If TypeOf Ctr Is MSForms.TextBox Or TypeOf Ctr Is MSForms.ComboBox Then
    i = i + 1
    sTxt = Ctr.Name
    iPos = Dic.Item(sTxt)
    Arr(iPos) = Ctr.Value
    Ctr.Value = ""
  End If
Next
Arr(5) = Arr(5) * 1
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
NDU hướng dẫn giúp.
 

File đính kèm

Từ từ cho em nó học, anh làm quá em nó choán hết thì làm sao dám tiếp...
Em nghĩ cái vòng lặp Tùng làm ở trên, Tùng nên nghiên cứu ứng dụng để rút gọn code nhập liệu luôn.
 
Từ từ cho em nó học, anh làm quá em nó choán hết thì làm sao dám tiếp...
Em nghĩ cái vòng lặp Tùng làm ở trên, Tùng nên nghiên cứu ứng dụng để rút gọn code nhập liệu luôn.

PHP:
Private Sub CommandButton1_Click()
Dim LastRowData, i As Integer
LastRowData = Sheet3.Range("a50000").End(xlUp).Row + 1
Dim ctr As Control
i = 0
For Each ctr In NHAPLIEU.Controls   
If TypeOf ctr Is MSForms.TextBox Or TypeOf ctr Is MSForms.ComboBox Then      
i = i + 1      
Sheets("Data").Cells(LastRowData, i) = ctr.Value      
ctr.Value = ""   
End If
Next
End Sub

PS: Cho hỏi trường hợp nếu các textbox chúng ta vẽ không theo thứ tự thì sao? có cách nào ngoài việc sắp xếp các tbox theo đúng thứ tự.
 

File đính kèm

Lần chỉnh sửa cuối:
PHP:
Private Sub CommandButton1_Click()
Dim LastRowData, i As Integer
LastRowData = Sheet3.Range("a50000").End(xlUp).Row + 1
Dim ctr As Control
i = 0
For Each ctr In NHAPLIEU.Controls   
If TypeOf ctr Is MSForms.TextBox Or TypeOf ctr Is MSForms.ComboBox Then      
i = i + 1      
Sheets("Data").Cells(LastRowData, i) = ctr.Value      
ctr.Value = ""   
End If
Next
End Sub

PS: Cho hỏi trường hợp nếu các textbox chúng ta vẽ không theo thứ tự thì sao? có cách nào ngoài việc sắp xếp các tbox theo đúng thứ tự.
Em trai ơi, mấy cái textbox cho xử lý cho nó thành hoa thường luôn cho nó đẹp và đồng loạt dữ liệu.
 
PS: Cho hỏi trường hợp nếu các textbox chúng ta vẽ không theo thứ tự thì sao? có cách nào ngoài việc sắp xếp các tbox theo đúng thứ tự.
Cái này mới học từ ndu là thêm tag trong thuộc tính của TxtBox...
Nó sẽ lấy theo TT của tag.
PHP:
Private Sub CommandButton1_Click()
LastRow = Sheets("Data").Range("a50000").End(xlUp).Row + 1
For Each Ctr In NHAPLIEU.Controls
  If TypeOf Ctr Is MSForms.TextBox Or TypeOf Ctr Is MSForms.ComboBox Then
    i = Ctr.Tag
    Sheets("Data").Cells(LastRow, i) = Ctr.Value
    Ctr.Value = ""
  End If
Next
End Sub
 

File đính kèm

Vậy có nghĩa là có thể dùng ADO lấy dữ liệu cho vào 1 mảng? (tôi thắc mắc hôm trước, nay mới có trả lời)
Ngon!
----------------------
Mà nè, cái đoạn này:

Không nên dùng như vậy! Tốt nhất là dùng 2 vòng lập để transpose sẽ hay và nhanh hơn (đó là chưa nói đến trường hợp hàm TRANSPOSE có giới hạn sẽ bị "vỡ" với dữ liệu lớn)
----------------------
Nhân tiện, Hai Lúa hướng dẫn cách lọc Unique đi (phải thêm code gì?)

Unique là cái thủ tục này nè:

PHP:
            sSQL = "SELECT FieldUnique " _
                 & "FROM TableUnique " _
                 & "GROUP BY FieldUnique"
 
Unique là cái thủ tục này nè:

PHP:
            sSQL = "SELECT FieldUnique " _
                 & "FROM TableUnique " _
                 & "GROUP BY FieldUnique"
Để lấy dữ liệu duy nhất anh nên dùng distinct cho gọn nhé, ví dụ như sau:

Mã:
   sSQL = "SELECT [B][COLOR=#ff0000]distinct [/COLOR][/B]FieldUnique " _
                 & "FROM TableUnique "

Gọn hơn 1 dòng và hình như tốc độ cũng có khác đấy.
 

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

Back
Top Bottom