Newbie nhờ các cao nhân giúp đỡ về bảng nhập liệu

Liên hệ QC
lochx93

lochx93

Thành viên mới
Tham gia
18/11/19
Bài viết
6
Được thích
0
Em có bảng Excel trong file đính kèm, sheet 1 là mẫu khảo sát, em muốn khi mình điền xong khảo sát ấn "Nhập Liệu" thì dữ liệu sẽ tự tổng hợp vào bảng ở sheet 2. mà mã ở số phiếu ở sheet 1 quy định là nếu ấn 1 thì bảng tổng hợp sẽ tự nhận là HCNS, ấn 2 tự nhận là Kế toán. Em có tìm hiểu qua thì cách làm bằng VBA nhưng khó hiểu quá, mong các bác giúp đỡ, em cảm ơn.
 

File đính kèm

  • khảo sát.xls
    63 KB · Đọc: 18
Sắp xếp theo thời gian sắp xếp theo bầu chọn
lochx93 đã viết:
Phiếu này em đã in ra rồi phát cho công nhân trong công ty rồi, giờ thu lại để làm bảng tổng kết. Các bác đừng hỏi e sao lại không dùng form điện tử nhé. Công ty em là công ty may, có rất nhiều các cô các bác lớn tuổi không biết dùng smartphone hay máy tính nên bắt buộc phải in giấy.
Nhấp chuột vào đây để mở rộng...
Thôi được, không góp ý gì nữa. Làm theo đơn đặt hàng. Đoán mò thôi chứ bạn có cho ví dụ kết quả mong đợi cho dữ liệu nhập giả lập đâu.

Đọc kỹ các ghi chú để hiểu triết lý của code. Code kiểm tra tính hợp lệ của từng dữ liệu nhập.
Mã: 
Sub tonghop_khaosat()
'    Luu y:
'    - De don gian code thi STT o cot L phai lien tiep, bat dau tu 1 - du lieu bat dau tu dong 4
'    - So phieu nhap o E1
'    - trong Sheet2 co dung 10 cot voi tieu de va thu tu nhu hien tai. Ket qua bat dau tu dong 4
     - So phieu trong cot L:M co the them bot.
Dim lastRow As Long, k As Long, sophieu As Long, Arr, sp(), sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    With sh
        lastRow = .Cells(Rows.Count, "L").End(xlUp).Row
        If lastRow < 4 Then
            Application.Assistant.DoAlert "Error", "Kh" & ChrW(244) & "ng c" & ChrW(243) & " b" & ChrW(7843) & "ng phi" & ChrW(7871) & "u!", _
                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
            Exit Sub
        End If
'        mang So phieu
        sp = .Range("L4:M" & lastRow).Value
'        So phieu nhap
        sophieu = .Range("E1").Value
    End With
'    kiem tra so phieu
    If sophieu < 1 Or sophieu > UBound(sp) Then
        Application.Assistant.DoAlert "Error", "S" & ChrW(7889) & " phi" & ChrW(7871) & "u kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879) & ".", _
                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
        Exit Sub
    End If
'    mang 10 phan tu. 8 phan tu cuoi chua chi so cac CheckBox
    Arr = Array(0, 0, 4, 5, 9, 10, 15, 16, 22, 23)
'    neu CheckBox co chi so Arr(k) duoc chon thi Arr(k) = "x", nguoc lai thi Arr(k) = trong
'    O day ta loi dung mang Arr lam mang ket qua
    For k = 2 To 9
        If sh.Shapes("Check Box " & Arr(k)).ControlFormat.Value = 1 Then
            Arr(k) = "x"
        Else
            Arr(k) = ""
        End If
    Next k
'    kiem tra du lieu nhap
    For k = 1 To 4
        If Arr(2 * k) = Arr(2 * k + 1) Then
'            2 CheckBox cua cung cau hoi deu duoc chon hoac deu khong duoc chon - khong hop le
            Application.Assistant.DoAlert "Error", "C" & ChrW(226) & "u tr" & ChrW(7843) & " l" & ChrW(7901) & "i " & k & _
                                        " kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879), _
                                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
            Exit For
        End If
    Next k
'    neu khong co loi thi k > 4. Nhap ket qua xuong Sheet2
    If k > 4 Then
        With ThisWorkbook.Worksheets("Sheet2")
'            dong nhap ket qua
            lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            If lastRow <= 4 Then lastRow = 4
'            STT
            Arr(0) = lastRow - 3
'            So phieu
            Arr(1) = sp(sophieu, 2)
'            nhap ket qua
            .Cells(lastRow, "A").Resize(, UBound(Arr) + 1).Value = Arr
        End With
    End If
End Sub
 

File đính kèm

  • khảo sát.xls
    87 KB · Đọc: 22
Upvote 0
batman1 đã viết:
Thôi được, không góp ý gì nữa. Làm theo đơn đặt hàng. Đoán mò thôi chứ bạn có cho ví dụ kết quả mong đợi cho dữ liệu nhập giả lập đâu.

Đọc kỹ các ghi chú để hiểu triết lý của code. Code kiểm tra tính hợp lệ của từng dữ liệu nhập.
Mã: 
Sub tonghop_khaosat()
'    Luu y:
'    - De don gian code thi STT o cot L phai lien tiep, bat dau tu 1 - du lieu bat dau tu dong 4
'    - So phieu nhap o E1
'    - trong Sheet2 co dung 10 cot voi tieu de va thu tu nhu hien tai. Ket qua bat dau tu dong 4
     - So phieu trong cot L:M co the them bot.
Dim lastRow As Long, k As Long, sophieu As Long, Arr, sp(), sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    With sh
        lastRow = .Cells(Rows.Count, "L").End(xlUp).Row
        If lastRow < 4 Then
            Application.Assistant.DoAlert "Error", "Kh" & ChrW(244) & "ng c" & ChrW(243) & " b" & ChrW(7843) & "ng phi" & ChrW(7871) & "u!", _
                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
            Exit Sub
        End If
'        mang So phieu
        sp = .Range("L4:M" & lastRow).Value
'        So phieu nhap
        sophieu = .Range("E1").Value
    End With
'    kiem tra so phieu
    If sophieu < 1 Or sophieu > UBound(sp) Then
        Application.Assistant.DoAlert "Error", "S" & ChrW(7889) & " phi" & ChrW(7871) & "u kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879) & ".", _
                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
        Exit Sub
    End If
'    mang 10 phan tu. 8 phan tu cuoi chua chi so cac CheckBox
    Arr = Array(0, 0, 4, 5, 9, 10, 15, 16, 22, 23)
'    neu CheckBox co chi so Arr(k) duoc chon thi Arr(k) = "x", nguoc lai thi Arr(k) = trong
'    O day ta loi dung mang Arr lam mang ket qua
    For k = 2 To 9
        If sh.Shapes("Check Box " & Arr(k)).ControlFormat.Value = 1 Then
            Arr(k) = "x"
        Else
            Arr(k) = ""
        End If
    Next k
'    kiem tra du lieu nhap
    For k = 1 To 4
        If Arr(2 * k) = Arr(2 * k + 1) Then
'            2 CheckBox cua cung cau hoi deu duoc chon hoac deu khong duoc chon - khong hop le
            Application.Assistant.DoAlert "Error", "C" & ChrW(226) & "u tr" & ChrW(7843) & " l" & ChrW(7901) & "i " & k & _
                                        " kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879), _
                                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
            Exit For
        End If
    Next k
'    neu khong co loi thi k > 4. Nhap ket qua xuong Sheet2
    If k > 4 Then
        With ThisWorkbook.Worksheets("Sheet2")
'            dong nhap ket qua
            lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            If lastRow <= 4 Then lastRow = 4
'            STT
            Arr(0) = lastRow - 3
'            So phieu
            Arr(1) = sp(sophieu, 2)
'            nhap ket qua
            .Cells(lastRow, "A").Resize(, UBound(Arr) + 1).Value = Arr
        End With
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác. thanks ! thanks u! thanks you so much!
Bài đã được tự động gộp:

batman1 đã viết:
Thôi được, không góp ý gì nữa. Làm theo đơn đặt hàng. Đoán mò thôi chứ bạn có cho ví dụ kết quả mong đợi cho dữ liệu nhập giả lập đâu.

Đọc kỹ các ghi chú để hiểu triết lý của code. Code kiểm tra tính hợp lệ của từng dữ liệu nhập.
Mã: 
Sub tonghop_khaosat()
'    Luu y:
'    - De don gian code thi STT o cot L phai lien tiep, bat dau tu 1 - du lieu bat dau tu dong 4
'    - So phieu nhap o E1
'    - trong Sheet2 co dung 10 cot voi tieu de va thu tu nhu hien tai. Ket qua bat dau tu dong 4
     - So phieu trong cot L:M co the them bot.
Dim lastRow As Long, k As Long, sophieu As Long, Arr, sp(), sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    With sh
        lastRow = .Cells(Rows.Count, "L").End(xlUp).Row
        If lastRow < 4 Then
            Application.Assistant.DoAlert "Error", "Kh" & ChrW(244) & "ng c" & ChrW(243) & " b" & ChrW(7843) & "ng phi" & ChrW(7871) & "u!", _
                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
            Exit Sub
        End If
'        mang So phieu
        sp = .Range("L4:M" & lastRow).Value
'        So phieu nhap
        sophieu = .Range("E1").Value
    End With
'    kiem tra so phieu
    If sophieu < 1 Or sophieu > UBound(sp) Then
        Application.Assistant.DoAlert "Error", "S" & ChrW(7889) & " phi" & ChrW(7871) & "u kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879) & ".", _
                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
        Exit Sub
    End If
'    mang 10 phan tu. 8 phan tu cuoi chua chi so cac CheckBox
    Arr = Array(0, 0, 4, 5, 9, 10, 15, 16, 22, 23)
'    neu CheckBox co chi so Arr(k) duoc chon thi Arr(k) = "x", nguoc lai thi Arr(k) = trong
'    O day ta loi dung mang Arr lam mang ket qua
    For k = 2 To 9
        If sh.Shapes("Check Box " & Arr(k)).ControlFormat.Value = 1 Then
            Arr(k) = "x"
        Else
            Arr(k) = ""
        End If
    Next k
'    kiem tra du lieu nhap
    For k = 1 To 4
        If Arr(2 * k) = Arr(2 * k + 1) Then
'            2 CheckBox cua cung cau hoi deu duoc chon hoac deu khong duoc chon - khong hop le
            Application.Assistant.DoAlert "Error", "C" & ChrW(226) & "u tr" & ChrW(7843) & " l" & ChrW(7901) & "i " & k & _
                                        " kh" & ChrW(244) & "ng h" & ChrW(7907) & "p l" & ChrW(7879), _
                                        msoAlertButtonOK, msoAlertIconCritical, 0, 0, 0
            Exit For
        End If
    Next k
'    neu khong co loi thi k > 4. Nhap ket qua xuong Sheet2
    If k > 4 Then
        With ThisWorkbook.Worksheets("Sheet2")
'            dong nhap ket qua
            lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            If lastRow <= 4 Then lastRow = 4
'            STT
            Arr(0) = lastRow - 3
'            So phieu
            Arr(1) = sp(sophieu, 2)
'            nhap ket qua
            .Cells(lastRow, "A").Resize(, UBound(Arr) + 1).Value = Arr
        End With
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Bác cho e hỏi chút là em muốn ấn "Nhập liệu" xong thì dữ liệu nhập trước biến mất để nhập phiếu mới thì làm thế nào ạ.
 
Upvote 0
lochx93 đã viết:
Em cảm ơn bác. Cảm ơn ! Cảm ơn u! Cảm ơn you so much!
Bác cho e hỏi chút là em muốn ấn "Nhập liệu" xong thì dữ liệu nhập trước biến mất để nhập phiếu mới thì làm thế nào ạ.
Nhấp chuột vào đây để mở rộng...
Ở cuối cùng có cụm code
Mã: 
If k > 4 Then
    With ThisWorkbook.Worksheets("Sheet2")
...
    End With
End If

Sau dòng End With thì thêm cụm
Mã: 
    Arr = Array(0, 0, 4, 5, 9, 10, 15, 16, 22, 23)
    For k = 2 To 9
        sh.Shapes("Check Box " & Arr(k)).ControlFormat.Value = -4146
    Next k
    sh.Range("E1").Value = Empty
    sh.Range("E1").Select
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
2
Đọc
44
phantuancauvan
P
phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
2
Trả lời
28
Đọc
389
VetMini
V
tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
23
tby211
tby211
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
6
Đọc
147
NguyenthiH
NguyenthiH
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
508
ngochienbmt
N
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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

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

Back
Top Bottom