Tổng hợp dữ liệu từ nhiều file excel vào 1 file

Liên hệ QC MyVTV Add-ins

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Thử file. Bấm nút để chạy code.
Cảm ơn bạn Maika8008 nhé!
Sau 1 thời gian mình đã chạy thử chương trình báo cáo bạn như sau:
- Phải nói quá tuyệt vời ( nhanh gọn ), khớp với dữ liệu.
- Trong quá trình mô tả yêu cầu còn thiếu thông tin cột ghi chú của sheet(PHIEU), mình cũng bổ sung được rồi ( ...F44, F49 From... ).
- Trong Code còn thiếu 3 thông tin: Điện thoại: Cell( Z3 ), Thường trú: Cell( AA2 ), Tạm Trú: Cell( AC2 ). 3 thông tin này lấy từ dòng trường dữ liệu của chủ hộ của Sheet(DATA). Tại Sheet(DATA) cột Q tại dòng dữ liệu chủ hộ nếu có dữ liệu " Vắng " thì ghi vào sheet(PHIEU) tại Cell( AA2 ) Nếu có dữ liệu " Lưu trú " thì ghi vào Cell( AC2 ), Cột ( AY ) nếu có dữ liệu số điện thoại thì ghi vào Cell( Z3 ). Mong bạn hướng dẫn thêm. Chào bạn.
 

hiv174

Thành viên mới
Tham gia ngày
12 Tháng bảy 2017
Bài viết
16
Được thích
2
Giới tính
Nam
Cảm ơn bạn Maika8008 nhé!
Sau 1 thời gian mình đã chạy thử chương trình báo cáo bạn như sau:
- Phải nói quá tuyệt vời ( nhanh gọn ), khớp với dữ liệu.
- Trong quá trình mô tả yêu cầu còn thiếu thông tin cột ghi chú của sheet(PHIEU), mình cũng bổ sung được rồi ( ...F44, F49 From... ).
- Trong Code còn thiếu 3 thông tin: Điện thoại: Cell( Z3 ), Thường trú: Cell( AA2 ), Tạm Trú: Cell( AC2 ). 3 thông tin này lấy từ dòng trường dữ liệu của chủ hộ của Sheet(DATA). Tại Sheet(DATA) cột Q tại dòng dữ liệu chủ hộ nếu có dữ liệu " Vắng " thì ghi vào sheet(PHIEU) tại Cell( AA2 ) Nếu có dữ liệu " Lưu trú " thì ghi vào Cell( AC2 ), Cột ( AY ) nếu có dữ liệu số điện thoại thì ghi vào Cell( Z3 ). Mong bạn hướng dẫn thêm. Chào bạn.
bác cho em hỏi với file của bác lúc xuất ra file 1C và 1D thì có cả xóm 1D,1E,1CS trong đó thì có đúng không bác? cảm ơn bác!
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Lần chỉnh sửa cuối:

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Cảm ơn bạn Maika8008 nhé!
Sau 1 thời gian mình đã chạy thử chương trình báo cáo bạn như sau:
- Phải nói quá tuyệt vời ( nhanh gọn ), khớp với dữ liệu.
- Trong quá trình mô tả yêu cầu còn thiếu thông tin cột ghi chú của sheet(PHIEU), mình cũng bổ sung được rồi ( ...F44, F49 From... ).
- Trong Code còn thiếu 3 thông tin: Điện thoại: Cell( Z3 ), Thường trú: Cell( AA2 ), Tạm Trú: Cell( AC2 ). 3 thông tin này lấy từ dòng trường dữ liệu của chủ hộ của Sheet(DATA). Tại Sheet(DATA) cột Q tại dòng dữ liệu chủ hộ nếu có dữ liệu " Vắng " thì ghi vào sheet(PHIEU) tại Cell( AA2 ) Nếu có dữ liệu " Lưu trú " thì ghi vào Cell( AC2 ), Cột ( AY ) nếu có dữ liệu số điện thoại thì ghi vào Cell( Z3 ). Mong bạn hướng dẫn thêm. Chào bạn.
Hướng dẫn cho bạn làm thử nghe:
1/ Thêm 2 trường F15 và F48 vào đoạn SQL thứ hai (đoạn lấy kết quả trung gian) để lấy thêm 2 cột Q và cột AY của DATA.
Tại sheet4:
2/ Trích chữ "chủ hộ" từ ô J2 (vì không gõ trên VBA được).
3/ Dùng phương thức Find VBA để tìm lấy số dòng của chữ "chủ hộ" trong cột D từ "D9: D" & dongcuoi (dòng cuối cùng của dữ liệu kết quả). Tạm dùng biến DongCH để lưu dòng đó
4/ lấy "AO" & DongCH gán vào ô Z3
5/ Nếu AN & DongCH có ký từ đầu là V (tức ô chứa chữ Vắng) thì lấy nó gán vào AA2. Nếu AN & DongCH có ký từ đầu là L (tức ô chứa chữ Lưu trú) thì lấy nó gán vào AC2
Xong./.
 

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Hướng dẫn cho bạn làm thử nghe:
1/ Thêm 2 trường F15 và F48 vào đoạn SQL thứ hai (đoạn lấy kết quả trung gian) để lấy thêm 2 cột Q và cột AY của DATA.
Tại sheet4:
2/ Trích chữ "chủ hộ" từ ô J2 (vì không gõ trên VBA được).
3/ Dùng phương thức Find VBA để tìm lấy số dòng của chữ "chủ hộ" trong cột D từ "D9: D" & dongcuoi (dòng cuối cùng của dữ liệu kết quả). Tạm dùng biến DongCH để lưu dòng đó
4/ lấy "AO" & DongCH gán vào ô Z3
5/ Nếu AN & DongCH có ký từ đầu là V (tức ô chứa chữ Vắng) thì lấy nó gán vào AA2. Nếu AN & DongCH có ký từ đầu là L (tức ô chứa chữ Lưu trú) thì lấy nó gán vào AC2
Xong./.
Cảm ơn bạn đã hướng dẫn ! Mình dựa vào phương thức ( code ) của bạn, từ đó mình viết code như thế này bạn xem có được hay không? ( nhìn thì không có bài bản cho lắm ).
1/ thêm 2 trường F15 và F48 vào đoạn SQL tiếp theo (đoạn lấy kết quả trung gian) để lấy thêm 2 cột Q và cột AY của DATA.
Tại sheet4: Ghi vào AF20 và AG20: Code như sau:
.Open ("Select F15, F48 From [DATA$C4:AY" & dong & "] Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
Sheet4.Range("AF16"). CopyFromRecordset . DataSource
.Close
2/ Chép dữ liệu từ Ô AF20 và ô AG20 vào Ô AA2, AC2 và Z3 Code như sau: (code này mình đặt ở cuối chương trình )

Sheet4.Range("Z9").Resize(UBound(arr, 1), 1) = arrKT
............................................

Range("Z3").Value = Range("AG20").Value
If Range("AF20").Value = "Lưu Trú" Then
Range("AC2").Value = "Lưu Trú"
ElseIf Range("AF20").Value = "V" & ChrW(7855) & "ng" Then
Range("AA2").Value = "V" & ChrW(7855) & "ng"
ElseIf Range("AF20").Value = "" Then
Range("AA2") = ""
Range("AC2") = ""
End If
Range("AF20:AG20").ClearContents
.........................................................

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Xong!"
3/ Xóa dữ liệu tạm: Range("AF20:AG20").ClearContents
* Khi nào bạn rảnh giúp dùm mình phần II nha. Chúc bạn buổi tối An lành và hạnh phúc.
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Cảm ơn bạn đã hướng dẫn ! Mình dựa vào phương thức ( code ) của bạn, từ đó mình viết code như thế này bạn xem có được hay không? ( nhìn thì không có bài bản cho lắm ).
1/ thêm 2 trường F15 và F48 vào đoạn SQL tiếp theo (đoạn lấy kết quả trung gian) để lấy thêm 2 cột Q và cột AY của DATA.
Tại sheet4: Ghi vào AF20 và AG20: Code như sau:
.Open ("Select F15, F48 From [DATA$C4:AY" & dong & "] Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
Sheet4.Range("AF16"). CopyFromRecordset . DataSource
.Close
2/ Chép dữ liệu từ Ô AF20 và ô AG20 vào Ô AA2, AC2 và Z3 Code như sau: (code này mình đặt ở cuối chương trình )

Sheet4.Range("Z9").Resize(UBound(arr, 1), 1) = arrKT
............................................

Range("Z3").Value = Range("AG20").Value
If Range("AF20").Value = "Lưu Trú" Then
Range("AC2").Value = "Lưu Trú"
ElseIf Range("AF20").Value = "V" & ChrW(7855) & "ng" Then
Range("AA2").Value = "V" & ChrW(7855) & "ng"
ElseIf Range("AF20").Value = "" Then
Range("AA2") = ""
Range("AC2") = ""
End If
Range("AF20:AG20").ClearContents
.........................................................

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Xong!"
3/ Xóa dữ liệu tạm: Range("AF20:AG20").ClearContents
* Khi nào bạn rảnh giúp dùm mình phần II nha. Chúc bạn buổi tối An lành và hạnh phúc.
Vấn đề là chạy được không, kết quả có đúng không? Với bạn thì cứ chạy được là được, bất chấp code dài code ngắn, bất chấp truyền thống hoặc thông lệ.
 

hiv174

Thành viên mới
Tham gia ngày
12 Tháng bảy 2017
Bài viết
16
Được thích
2
Giới tính
Nam
1C thì sẽ có thêm 1CS (nếu có 1CS), còn 1D không thể ra 1E được
Khi em chạy ấn xuất file trong TONG HOP thì có tạo ra file 1D. Trong 1D có cả 1E; 1 CS; thậm chí có cả CS tại dòng 1913 đến 1918 (em có gửi file đi kèm - 1C cũng tương tự)
 

File đính kèm

  • TONG HOP_huynhphuong thcspt.xlsm
    1 MB · Đọc: 4
  • 1D.xlsx
    497.8 KB · Đọc: 2
  • 1C.xlsx
    706 KB · Đọc: 2

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Khi em chạy ấn xuất file trong TONG HOP thì có tạo ra file 1D. Trong 1D có cả 1E; 1 CS; thậm chí có cả CS tại dòng 1913 đến 1918 (em có gửi file đi kèm - 1C cũng tương tự)
Đang chuyện mới bạn lại hỏi lấn sang chuyện cũ. Vậy câu trả lời bài #63 của tôi là vô nghĩa.
Lỗi tại chỗ này: đang 1CS tự nhiên lại chen vào 1D CS. Nó lấy từ dòng đầu khi tìm thấy 1D đến dòng 4310.
1623378524767.png
 
Lần chỉnh sửa cuối:

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
@huynhphuong thcspt
Code có bổ sung phần hướng dẫn ở bài #64
Rich (BB code):
Sub Loc()
Dim Rec As Object, dong As Long, i As Long, j As Long, dCH As Long
Dim Xom As String, Phieu As String, sCH As String
Dim arr, arrKT

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheet4.Range("B9:CB500").ClearContents
    dong = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
    Phieu = "'" & Sheet4.Range("C1") & "'"
    Xom = "'%" & Sheet4.Range("C2") & "%'"
    Dim cnn As String
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    Set Rec = CreateObject("ADODB.Recordset")
    With Rec
        .Open ("Select F1,F2,F46,F3,F4,F5,F6,F7,F8,F47,F17,F19,F21,F22,F23,F24,F26,F27,F28,F29,F30,F31,F32,F33,F41,F42,F43,F44 From [DATA$C4:AY" & dong & "]  Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
        Sheet4.Range("B9").CopyFromRecordset .DataSource
        .Close
        .Open ("Select F34, F35, F36, F37, F38, F39, F40, F41, F15, F48 From [DATA$C4:AY" & dong & "]  Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
        Sheet4.Range("AF9").CopyFromRecordset .DataSource
        .Close
        .Open ("Select First(F10),First(F11) From [DATA$C4:AY" & dong & "]  Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
        Sheet4.Range("L2").CopyFromRecordset .DataSource
        .Close
    End With
    Set Rec = Nothing
    arr = Sheet4.Range("AF9:AM" & Sheet4.Range("C" & Rows.Count).End(xlUp).Row)
    ReDim arrKT(1 To UBound(arr, 1), 1 To 1)
    For i = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            If Trim(arr(i, j)) <> "" Then arrKT(i, 1) = arrKT(i, 1) & Right(Sheet1.Cells(2, j + 35), Len(Sheet1.Cells(2, j + 35)) - 11) & "; "
        Next
        If Trim(arrKT(i, 1)) <> "" Then arrKT(i, 1) = Left(Trim(arrKT(i, 1)), Len(Trim(arrKT(i, 1))) - 1)
    Next
    Sheet4.Range("Z9").Resize(UBound(arr, 1), 1) = arrKT
    sCH = Mid(Sheet4.Range("J2"), InStr(1, Sheet4.Range("J2"), "ch"), 6)
    dCH = Sheet4.Range("D9:D" & UBound(arr, 1) + 8).Find(What:=sCH, LookIn:=xlFormulas, LookAt:=xlWhole).Row
    Sheet4.Range("Z3") = Sheet4.Range("AO" & dCH)
    If UCase(Left(Sheet4.Range("AN" & dCH), 1)) = "V" Then
        Sheet4.Range("AA2") = Sheet4.Range("AN" & dCH)
    ElseIf UCase(Left(Sheet4.Range("AN" & dCH), 1)) = "L" Then
        Sheet4.Range("AC2") = Sheet4.Range("AN" & dCH)
    End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Xong!"
End Sub
 

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
@huynhphuong thcspt
Code có bổ sung phần hướng dẫn ở bài #64
Rich (BB code):
Sub Loc()
Dim Rec As Object, dong As Long, i As Long, j As Long, dCH As Long
Dim Xom As String, Phieu As String, sCH As String
Dim arr, arrKT

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheet4.Range("B9:CB500").ClearContents
    dong = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
    Phieu = "'" & Sheet4.Range("C1") & "'"
    Xom = "'%" & Sheet4.Range("C2") & "%'"
    Dim cnn As String
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
    Set Rec = CreateObject("ADODB.Recordset")
    With Rec
        .Open ("Select F1,F2,F46,F3,F4,F5,F6,F7,F8,F47,F17,F19,F21,F22,F23,F24,F26,F27,F28,F29,F30,F31,F32,F33,F41,F42,F43,F44 From [DATA$C4:AY" & dong & "]  Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
        Sheet4.Range("B9").CopyFromRecordset .DataSource
        .Close
        .Open ("Select F34, F35, F36, F37, F38, F39, F40, F41, F15, F48 From [DATA$C4:AY" & dong & "]  Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
        Sheet4.Range("AF9").CopyFromRecordset .DataSource
        .Close
        .Open ("Select First(F10),First(F11) From [DATA$C4:AY" & dong & "]  Where F13 = " & Phieu & " And F12 Like " & Xom), cnn
        Sheet4.Range("L2").CopyFromRecordset .DataSource
        .Close
    End With
    Set Rec = Nothing
    arr = Sheet4.Range("AF9:AM" & Sheet4.Range("C" & Rows.Count).End(xlUp).Row)
    ReDim arrKT(1 To UBound(arr, 1), 1 To 1)
    For i = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            If Trim(arr(i, j)) <> "" Then arrKT(i, 1) = arrKT(i, 1) & Right(Sheet1.Cells(2, j + 35), Len(Sheet1.Cells(2, j + 35)) - 11) & "; "
        Next
        If Trim(arrKT(i, 1)) <> "" Then arrKT(i, 1) = Left(Trim(arrKT(i, 1)), Len(Trim(arrKT(i, 1))) - 1)
    Next
    Sheet4.Range("Z9").Resize(UBound(arr, 1), 1) = arrKT
    sCH = Mid(Sheet4.Range("J2"), InStr(1, Sheet4.Range("J2"), "ch"), 6)
    dCH = Sheet4.Range("D9:D" & UBound(arr, 1) + 8).Find(What:=sCH, LookIn:=xlFormulas, LookAt:=xlWhole).Row
    Sheet4.Range("Z3") = Sheet4.Range("AO" & dCH)
    If UCase(Left(Sheet4.Range("AN" & dCH), 1)) = "V" Then
        Sheet4.Range("AA2") = Sheet4.Range("AN" & dCH)
    ElseIf UCase(Left(Sheet4.Range("AN" & dCH), 1)) = "L" Then
        Sheet4.Range("AC2") = Sheet4.Range("AN" & dCH)
    End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Xong!"
End Sub
Cảm ơn bạn MaiKa8008 đã bổ phần hướng dẫ ở bài #64.
Báo cáo: Chương trình chạy rất tốt, khớp với dữ liệu.
Khi nào bạn rảnh giúp dùm mình phần II ở bài #59 nha. Chào bạn!
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Cảm ơn bạn MaiKa8008 đã bổ phần hướng dẫ ở bài #64.
Báo cáo: Chương trình chạy rất tốt, khớp với dữ liệu.
Khi nào bạn rảnh giúp dùm mình phần II ở bài #59 nha. Chào bạn!
Có nhiều code, cũng đủ dạng rồi. Tự làm 1 lần xem sao chứ yếu hoài vậy xem sao được.
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Có nhiều code, cũng đủ dạng rồi. Tự làm 1 lần xem sao chứ yếu hoài vậy xem sao được.
Bạn nghiên cứu code nhé, nhất là mấy cái Array về chỉ số cột để cập nhật từ arrCol đến arrCol3. Không có cách đó code sẽ dài ngoằng à.
 

File đính kèm

  • XEM PHIEU_SQLinFILE_huynhphuong thcspt.xlsm
    3.3 MB · Đọc: 3

hiv174

Thành viên mới
Tham gia ngày
12 Tháng bảy 2017
Bài viết
16
Được thích
2
Giới tính
Nam
Có nhiều code, cũng đủ dạng rồi. Tự làm 1 lần xem sao chứ yếu hoài vậy xem sao được.
Em có thể hỏi riêng bác trước được không ? cảm ơn bác ! Em có file "chia nhom" bác có thể xem qua giúp em được không ? Em muốn nhờ giúp nhưng chưa rõ file của mình trong đó có dễ hiểu hay có chỗ nào chưa rõ ràng không! Em cảm ơn bác!
 

File đính kèm

  • chia nhom.xlsm
    222.6 KB · Đọc: 2

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Em có thể hỏi riêng bác trước được không ? cảm ơn bác ! Em có file "chia nhom" bác có thể xem qua giúp em được không ? Em muốn nhờ giúp nhưng chưa rõ file của mình trong đó có dễ hiểu hay có chỗ nào chưa rõ ràng không! Em cảm ơn bác!
Bạn mở chủ đề mới đi để nhiều người khác còn biết. Tất nhiên tôi sẽ trợ giúp. Còn nếu người khác trợ giúp mà bạn thấy hài lòng thì tốt.
 

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Bạn nghiên cứu code nhé, nhất là mấy cái Array về chỉ số cột để cập nhật từ arrCol đến arrCol3. Không có cách đó code sẽ dài ngoằng à.
Chân thành cảm ơn bạn MaiKa8008 đã trợ giúp mình phần II bài #59.
Sau khi chạy thử chương trình, báo cáo bạn như sau:
Chương trình chạy tốt, bên cạnh đó còn vài lỗi nhỏ như sau:
1/ Xem thông tin số phiếu:
- Cột dữ liệu (chuyển đi, đến, chế), (Ghi chú); Thông tin thường trú, tạm trú và số điện thoại: Chưa khớp mình đã khắc phục được rồi ( F44,F45,F50 From ),..
- Nếu Phiếu và Xóm không có trong (DATA) thì chương trình báo lỗi ở câu lệnh sau: dCH = Sheet4.Range("D9:D" & UBound(arr, 1) + 8).Find(What:=sCH, LookIn:=xlFormulas, LookAt:=xlWhole).Row
2/ Cập nhật vào DATA:
- Cập nhật thêm dữ liệu cột ghi chú sheet(PHIEU) vào cột AY sheet(DATA) mình làm như sau:

Sub SaveInfoToData()
......
arrCol = Array(3, 4, 48, 5, 6, 7, 8, 9, 10, 49, 19, 21, 23, 24, 25, 26, 28, 29, 30, 31, 32, 33, 34, 35, 51) (bổ sung thêm 51)
......
For j = 1 To 24 sửa thành For j = 1 To 25
Không biết mình sửa như vây có đúng không nhưng khi chạy chương trình không cập nhật được dữ liệu.
Mong bạn hướng dẫn để khắc phục lỗi trên. Chào bàn.
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Chân thành cảm ơn bạn MaiKa8008 đã trợ giúp mình phần II bài #59.
Sau khi chạy thử chương trình, báo cáo bạn như sau:
Chương trình chạy tốt, bên cạnh đó còn vài lỗi nhỏ như sau:
1/ Xem thông tin số phiếu:
- Cột dữ liệu (chuyển đi, đến, chế), (Ghi chú); Thông tin thường trú, tạm trú và số điện thoại: Chưa khớp mình đã khắc phục được rồi ( F44,F45,F50 From ),..
- Nếu Phiếu và Xóm không có trong (DATA) thì chương trình báo lỗi ở câu lệnh sau: dCH = Sheet4.Range("D9:D" & UBound(arr, 1) + 8).Find(What:=sCH, LookIn:=xlFormulas, LookAt:=xlWhole).Row
2/ Cập nhật vào DATA:
- Cập nhật thêm dữ liệu cột ghi chú sheet(PHIEU) vào cột AY sheet(DATA) mình làm như sau:

Sub SaveInfoToData()
......
arrCol = Array(3, 4, 48, 5, 6, 7, 8, 9, 10, 49, 19, 21, 23, 24, 25, 26, 28, 29, 30, 31, 32, 33, 34, 35, 51) (bổ sung thêm 51)
......
For j = 1 To 24 sửa thành For j = 1 To 25
Không biết mình sửa như vây có đúng không nhưng khi chạy chương trình không cập nhật được dữ liệu.
Mong bạn hướng dẫn để khắc phục lỗi trên. Chào bàn.
Số 2/ nếu bạn làm như thế thì sẽ ghi cột loại khuyết tật của PHIEU (cột z) vào cột ghi chú của data => sai
Do đó phải thêm Sheet1.Cells(i, 51) = arr(k, 29) -> 51 thì bạn biết rồi (cột ghi chú của data), còn 29 là cột ghi chú của PHIEU.
Bài đã được tự động gộp:

Còn số 1: bạn bẫy lỗi để nó thông báo lỗi và kết thúc chương trình đi.
 
Lần chỉnh sửa cuối:

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Số 2/ nếu bạn làm như thế thì sẽ ghi cột loại khuyết tật của PHIEU (cột z) vào cột ghi chú của data => sai
Do đó phải thêm Sheet1.Cells(i, 51) = arr(k, 29) -> 51 thì bạn biết rồi (cột ghi chú của data), còn 29 là cột ghi chú của PHIEU.
Bài đã được tự động gộp:

Còn số 1: bạn bẫy lỗi để nó thông báo lỗi và kết thúc chương trình đi.
Chào bạn MaiKa8008 ! Cảm ơn bạn hướng dẫn cách để khắc phục lỗi ở bài #76.
Qua sự hướng dẫn của bạn mình đã khắc phục xong cụ thể:
1/ Mình thêm lệnh bẫy lỗi và thêm thông báo cuối đoạn Code.
Sub Loc()
On Error Resume Next
...............
If Sheet4.Range("L2") <> "" Then
MsgBox "Xong!"
Else
MsgBox "Khong co so phieu nay trong xom !"
End If
End Sub
2/ Cật nhập bổ sung thêm thông tin chủ hộ ở sheet(PHIEU): Họ tên chủ hô: L2, M2; Thường trú AA2, Tạm trú AC2; Điện thoại Z3 vào sheet(DATA):
a) Họ tên chủ hô: L2, M2; Thông tin ghi chú: Code như sau.
Sheet1.Cells(i, 51) = arr(k, 29) 'Cật nhật cột ghi chú (PHIEU) cột (29) vào (DATA) cột 51
Sheet1.Cells(i, 12) = Sheet4.Range("L2") ' Cập nhật họ chủ hộ (L2) vào (DATA) cột 12
Sheet1.Cells(i, 13) = Sheet4.Range("M2") 'Cập nhật tên chủ hộ (M2) vào (DATA) cột 13
b) Thường trú AA2, Tạm trú AC2; Điện thoại Z3 :Code như sau.
b.1/ Thông qua bảng tạm để cập nhập:
Sub SaveInfoToData()
..........
arr = Sheet4.Range("B9:AO" & endR) sửa AM thành AO
........................
Sheet1.Cells(i, 50) = arr(k, 40) 'Cập nhật điện thoại (bang tam) cột 40 vào (DATA) cột 50
Sheet1.Cells(i, 17) = arr(k, 39) 'Cập nhật cư trú (bang tam) cột 39 vào (DATA) cột 17
.................
b.2/ Cập nhật từ Ô AA2, AC2, Z3 rồi ghi dữ liệu vào bảng tạm từ bảng tạm ghi vào (DATA):

Sub SaveInfoToData()
.....................................
sCH = Mid(Sheet4.Range("J2"), InStr(1, Sheet4.Range("J2"), "ch"), 6)
dCH = Sheet4.Range("D9:D" & UBound(arr, 1) + 8).Find(What:=sCH, LookIn:=xlFormulas, LookAt:=xlWhole).Row
Sheet4.Range("AO" & dCH) = Sheet4.Range("Z3") 'Cập nhật điện thoại (Z3) vào bảng tạm cột 40 theo trường dữ liệu của chủ hộ
Sheet1.Cells(i, 50) = arr(k, 40) 'Cập nhật điện thoại từ bảng tạm cột 40 vào (DATA) cột 50

sCH = Mid(Sheet4.Range("J2"), InStr(1, Sheet4.Range("J2"), "ch"), 6)
dCH = Sheet4.Range("D9:D" & UBound(arr, 1) + 8).Find(What:=sCH, LookIn:=xlFormulas, LookAt:=xlWhole).Row
If Sheet4.Range("AA2") = "" And Sheet4.Range("AC2") = "" Then
Sheet4.Range("AN" & dCH) = Sheet4.Range("AA2") 'Cật nhật AA2 vào bảng tạm cột 39 theo trường dữ liệu chủ hộ
Sheet1.Cells(i, 17) = arr(k, 39) 'Cập nhật cư trú bảng tạm cột 39 vào (DATA) cột 17
ElseIf Sheet4.Range("AA2") <> "" And Sheet4.Range("AC2") = "" Then
Sheet4.Range("AN" & dCH) = Sheet4.Range("AA2") 'Cập nhật AA2 vào bảng tạm cột 39 theo trường dữ liệu chủ hộ
Sheet1.Cells(i, 17) = arr(k, 39) 'Cật nhập cư trú bảng tạm bảng tạm cột 39 vào (DATA) cột 17
ElseIf Sheet4.Range("AA2") = "" And Sheet4.Range("AC2") <> "" Then
Sheet4.Range("AN" & dCH) = Sheet4.Range("AC2") 'Cập nhập AC2 vào bảng tạm cột 39 theo trường dữ liệu chủ hộ
Sheet1.Cells(i, 17) = arr(k, 39) 'Cập nhập cư trú bảng tạm cột 39 vào (DATA) cột 17
End If
..................................
Cho mình hỏi ở mục b.2/ : Tại sao Click 2 lần vào nút lệnh (Cập nhập vào data) thì dữ liệu mới cập nhật vào (DATA). Có nghĩa là Click lần 1 vào nút lệnh thì dữ liệu mới cập nhập vào bảng tạm ( DATA chưa cập nhập ), Click lần 2 thì dữ liệu mới cập nhật vào DATA. Mong bạn chỉ dẫn đểgỡ rối vấn đề này. Chào bạn.
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
1/ Bẫy lỗi quên nhập phiếu tại L2 thì phải bẫy và thoát ngay từ đầu chứ sao lại để đến cuối.
Bẫy còn sót lỗi: có nhập phiếu tại L2 nhưng không tìm thấy số phiếu tại xóm đó.
2/ Dữ liệu ở b.2/ đã có tại bảng tạm rồi (AF đến AO - màu xanh - lấy để điền lên Z3, AA2 hoặc AC2): chừ chỉ cần thêm 2 dòng, sửa 1 dòng là chạy tốt chứ làm gì mà code ghê vậy:
Sửa arr = Sheet4.Range("B9:AM" & endR) thành arr = Sheet4.Range("B9:AO" & endR) để lấy thêm 2 cột nữa mà trước đó không lấy
Thêm
Sheet1.Cells(i, 17) = arr(k, 39)
Sheet1.Cells(i, 50) = arr(k, 40)
trước dòng Next cuối sub
Sau này hãy chép code vào trong thẻ code (công cụ đầu tiên bên trái) cho rõ ràng, chứ nhìn vậy rối, không đọc được
 

File đính kèm

  • XEM PHIEU_SQLinFILE_huynhphuong thcspt.xlsm
    3.3 MB · Đọc: 3
Lần chỉnh sửa cuối:

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
1/ Bẫy lỗi quên nhập phiếu tại L2 thì phải bẫy và thoát ngay từ đầu chứ sao lại để đến cuối.
Bẫy còn sót lỗi: có nhập phiếu tại L2 nhưng không tìm thấy số phiếu tại xóm đó.
2/ Dữ liệu ở b.2/ đã có tại bảng tạm rồi (AF đến AO - màu xanh - lấy để điền lên Z3, AA2 hoặc AC2): chừ chỉ cần thêm 2 dòng, sửa 1 dòng là chạy tốt chứ làm gì mà code ghê vậy:
Sửa arr = Sheet4.Range("B9:AM" & endR) thành arr = Sheet4.Range("B9:AO" & endR) để lấy thêm 2 cột nữa mà trước đó không lấy
Thêm
Sheet1.Cells(i, 17) = arr(k, 39)
Sheet1.Cells(i, 50) = arr(k, 40)
trước dòng Next cuối sub
Sau này hãy chép code vào trong thẻ code (công cụ đầu tiên bên trái) cho rõ ràng, chứ nhìn vậy rối, không đọc được
Chào buổi sáng! Cảm ơn bạn đã chỉ dẫn cho mình.
1/ Theo cách b.1/ Cập nhật dữ liệu từ nút lệnh (Cập nhật dữ liệu) vào DATA thông qua bảng tạm thì Ok rồi. ( Code trong file đính kèm (b.1) )
2/ Theo cách b.2/ Cập nhật dữ liệu từ nút lệnh (Cập nhật dữ liệu) vào DATA không thông qua bảng tạm ( Với 3 trường dữ liệu Z3, AA2 hoặc AC2 ).
Có nghĩa là nhập dữ liệu từ trực tiếp từ Ô Z3, AA2 hoặc AC2 (không mượm bảng tạm để nhập) vào DATA. (Code trong file đính kèm (b.2)
Mình nghi vấn tại sao ? Click 2 lần vào nút lệnh (Cập nhập vào data) thì dữ liệu mới cập nhật vào (DATA). Có nghĩa là Click lần 1 vào nút lệnh thì dữ liệu mới cập nhập vào bảng tạm ( DATA chưa cập nhập ), Click lần 2 thì dữ liệu mới cập nhật vào DATA. Mong bạn chỉ dẫn để gỡ rối vấn đề này. Chào bạn, Chúc bạn đầu tuần tốt lành và thành đạt !
Ghi chú: Mọi thông tin dữ liệu khác thì cập nhập bình thường.
 

File đính kèm

  • XEM PHIEU_SQLinFILE_huynhphuong thcspt (b.1).xlsm
    3.3 MB · Đọc: 0
  • XEM PHIEU_SQLinFILE_huynhphuong thcspt (b.2).xlsm
    3.3 MB · Đọc: 0
Top Bottom