Màn Hình Bị Giật Khi Chạy Macro | Giải Pháp Excel

Trang chủ » Excel Bị Giật Màn Hình » Màn Hình Bị Giật Khi Chạy Macro | Giải Pháp Excel

Có thể bạn quan tâm

Giải Pháp Excel
  • Trang chủ Có gì mới Hoạt động gần nhất Tác giả
  • Diễn đàn Tìm bài viết mới Tìm theo chuyên mục
  • Video New Video về Excel Video về tin học khác Tin tức về tin học chung
  • Thông tin mới Featured content Tìm bài mới Tài Nguyên Mới Hoạt động gần nhất
  • Tài nguyên Đánh giá mới nhất Tìm tài nguyên
  • Facebook
  • Đóng góp
Đăng nhập Đăng Ký Có gì mới? Tìm kiếm

Tìm kiếm

Mọi nơi Đề tài Diễn đàn này Đề tài này Chỉ tìm trong tiêu đề Note Bởi: Tìm kiếm Tìm nâng cao…
  • Tìm bài viết mới
  • Tìm theo chuyên mục
Menu Đăng nhập Đăng Ký Install the app Install How to install the app on iOS

Follow along with the video below to see how to install our site as a web app on your home screen.

Note: This feature may not be available in some browsers.

  • Khách ơi! GPE thông tin đến bạn ấn phẩm "lập trình VBA trong Excel": - Phần cơ bản - Phần Nâng Cao - VBA trong Excel - Cải thiện và tăng tốc
  • Trang chủ
  • Diễn đàn
  • Những vấn đề chung
You are using an out of date browser. It may not display this or other websites correctly.You should upgrade or use an alternative browser. Màn hình bị giật khi chạy macro (1 người xem)
  • Thread starter Thread starter JungSangAh
  • Ngày gửi Ngày gửi 14/10/18
Liên hệ QC

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

Đang trực tuyến: 2 (Thành viên: 0, Khách: 2) JungSangAh

JungSangAh

Thành viên mới
Tham gia 2/6/18 Bài viết 43 Được thích 14 Xin chào các anh chị ạ. Em có một file excel kèm theo rất mong được các anh chị giúp đỡ ạ. 1/ Khi em chạy macro "lưu" ở sheet "nhap_lieu", màn hình bị giật liên tục ạ. Các anh chị có thể khắc phục giúp em được ko ạ? 2/ Các anh chị có thể giúp em viết code để trích xuất dữ liệu từ sheet "nhap_lieu" sang sheet "CTGNM" theo các điều kiện ở sheet CTGNM được ko ạ? Do em mò mẫm làm VBA nên các câu lệnh chủ yếu bằng record macro nên chạy rất chậm và cứ chồng chéo nhau thôi ạ. Nếu anh chị nào có thời gian có thể kiện toàn code giúp em với ạ. Em xin chân thành cảm ơn mọi sự giúp đỡ của cả nhà ạ. Chúc cả nhà GPE cuối tuần vui vẻ ạ.

File đính kèm

  • PMKH_2.xlsm PMKH_2.xlsm 1.8 MB · Đọc: 21
giaiphap

giaiphap

==(^o^)==
Tham gia 12/3/07 Bài viết 5,808 Được thích 6,370 Donate (Momo) Donate Giới tính Nam
JungSangAh đã viết: Xin chào các anh chị ạ. Em có một file excel kèm theo rất mong được các anh chị giúp đỡ ạ. 1/ Khi em chạy macro "lưu" ở sheet "nhap_lieu", màn hình bị giật liên tục ạ. Các anh chị có thể khắc phục giúp em được ko ạ? 2/ Các anh chị có thể giúp em viết code để trích xuất dữ liệu từ sheet "nhap_lieu" sang sheet "CTGNM" theo các điều kiện ở sheet CTGNM được ko ạ? Do em mò mẫm làm VBA nên các câu lệnh chủ yếu bằng record macro nên chạy rất chậm và cứ chồng chéo nhau thôi ạ. Nếu anh chị nào có thời gian có thể kiện toàn code giúp em với ạ. Em xin chân thành cảm ơn mọi sự giúp đỡ của cả nhà ạ. Chúc cả nhà GPE cuối tuần vui vẻ ạ. Nhấp chuột vào đây để mở rộng...
File bạn chậm do. 1. Quá nhiều dữ liệu. 2. Quá nhiều định dạng. 3. Quá nhiều công thức. 4. Code của bạn chủ yếu là Record Macro, nên thao tác hầu như là trực tiếp đến ô trong sheet nên tốc độ xử lý sẽ chậm là đương nhiên. Cách khắc phục có thể gợi ý cho bạn như sau: 1. Không nên tô màu cho những vùng không sử dụng tới, ví dụ có những sheet dùng ít dữ liệu nhưng bạn lại tô màu nền hết cả sheet. 2. Hạn chế dùng hình ảnh trong sheet. 3. Những chổ dùng công thức nếu được thì chuyển sang dùng code luôn cho nhẹ. 4. Những chổ chưa dùng thì bỏ hẳn công thức đi cho nhẹ tính toán. 5. Thay các thao tác tính toán trực tiếp trên ô ra tính toán trên mảng sau đó gán ngược vào ô. Tôi chỉ góp vài ý vậy còn giúp thì thua, chỉ góp lời chứ không góp vốn. Thấy file của bạn một mâm code thế kia dò và sửa từng đoạn chắc chết. JungSangAh

JungSangAh

Thành viên mới
Tham gia 2/6/18 Bài viết 43 Được thích 14
giaiphap đã viết: File bạn chậm do. 1. Quá nhiều dữ liệu. 2. Quá nhiều định dạng. 3. Quá nhiều công thức. 4. Code của bạn chủ yếu là Record Macro, nên thao tác hầu như là trực tiếp đến ô trong sheet nên tốc độ xử lý sẽ chậm là đương nhiên. Cách khắc phục có thể gợi ý cho bạn như sau: 1. Không nên tô màu cho những vùng không sử dụng tới, ví dụ có những sheet dùng ít dữ liệu nhưng bạn lại tô màu nền hết cả sheet. 2. Hạn chế dùng hình ảnh trong sheet. 3. Những chổ dùng công thức nếu được thì chuyển sang dùng code luôn cho nhẹ. 4. Những chổ chưa dùng thì bỏ hẳn công thức đi cho nhẹ tính toán. 5. Thay các thao tác tính toán trực tiếp trên ô ra tính toán trên mảng sau đó gán ngược vào ô. Tôi chỉ góp vài ý vậy còn giúp thì thua, chỉ góp lời chứ không góp vốn. Thấy file của bạn một mâm code thế kia dò và sửa từng đoạn chắc chết. Nhấp chuột vào đây để mở rộng...
Bài đã được tự động gộp: 14/10/18 Dạ, em cảm ơn góp ý của anh ạ. Em chưa hiểu mục "5. Thay các thao tác tính toán trực tiếp trên ô ra tính toán trên mảng sau đó gán ngược vào ô ". Anh có thể ví dụ giúp em ko ạ? vanthinh3101

vanthinh3101

Thành viên tích cực
Tham gia 24/1/15 Bài viết 1,129 Được thích 1,494 Giới tính Nam Nghề nghiệp Finance
JungSangAh đã viết: Xin chào các anh chị ạ. Em có một file excel kèm theo rất mong được các anh chị giúp đỡ ạ. 1/ Khi em chạy macro "lưu" ở sheet "nhap_lieu", màn hình bị giật liên tục ạ. Các anh chị có thể khắc phục giúp em được ko ạ? 2/ Các anh chị có thể giúp em viết code để trích xuất dữ liệu từ sheet "nhap_lieu" sang sheet "CTGNM" theo các điều kiện ở sheet CTGNM được ko ạ? Do em mò mẫm làm VBA nên các câu lệnh chủ yếu bằng record macro nên chạy rất chậm và cứ chồng chéo nhau thôi ạ. Nếu anh chị nào có thời gian có thể kiện toàn code giúp em với ạ. Em xin chân thành cảm ơn mọi sự giúp đỡ của cả nhà ạ. Chúc cả nhà GPE cuối tuần vui vẻ ạ. Nhấp chuột vào đây để mở rộng...
Một số ý kiến 1/ Màn hình bị giật liên tục vì bạn đang thiết lập sự kiện Worksheet_Change, trong khi code Lưu lại có nhiều lần active các ô trong sheet "nhaplieu" Để khắc phục tôi có sửa lại code của bạn như sau: PHP: Sao chép. Sub Lenh_luu_nhaplieu_dasua() Dim SourceData As Variant, DVGM(), DVNM(), GetData(1 To 1, 1 To 16) Dim lR As Long, I As Long Application.ScreenUpdating = False lR = Sheet82.Range("B" & Rows.Count).End(xlUp).Row + 1 'Dong cuoi cot B DVGM = Sheet23.Range("B10", Sheet23.Range("B10").End(xlDown)).Resize(, 2).Value DVNM = Sheet83.Range("B10", Sheet83.Range("B10").End(xlDown)).Resize(, 2).Value SourceData = Array("C1", "C2", "", "C3", "C4", "C5", "C6", "E2", "", "E3", "E4", "E5", "E6", "E1", "C7") 'Dien so thu tu If lR = 9 Then GetData(1, 1) = 1 Else GetData(1, 1) = Sheet82.Range("A" & lR).Offset(-1).Value + 1 End If 'Lay cac thong tin tu cac o C1, C2,... vao mang ket qua For I = LBound(SourceData) To UBound(SourceData) If Len(SourceData(I)) Then GetData(1, I + 2) = Sheet82.Range(SourceData(I)) Next I 'Lay thong tin don vi gui mau For I = 1 To UBound(DVGM, 1) If GetData(1, 3) = DVGM(I, 1) Then GetData(1, 4) = DVGM(I, 2) Exit For End If Next I 'Lay thong tin don vi nhan mau For I = 1 To UBound(DVNM, 1) If GetData(1, 9) = DVNM(I, 1) Then GetData(1, 10) = DVNM(I, 2) Exit For End If Next I 'Gan mang ket qua vao dong cuoi Sheet82.Range("A" & lR).Resize(, 16) = GetData 'Lay thong tin So phieu GM/PT Sheet82.Range("P" & lR) = Left(Sheet82.Range("C" & lR), InStr(Sheet82.Range("C" & lR), "/")) & _ ".T" & Month(Sheet82.Range("B" & lR)) & "/" & _ Format(Application.WorksheetFunction.CountIf(Sheet82.Range("C9:C" & lR), _ Left(Sheet82.Range("C" & lR), InStr(Sheet82.Range("C" & lR), "/")) & "*"), "000") Application.ScreenUpdating = True MsgBox "Da luu du lieu", vbInformation, "GPE" End Sub Tiện viết lại luôn code cho sự kiện Worksheet_Change cho gọn PHP: Sao chép. Sub Lenh_lay_ND_nhaplieu_dasua() Dim a As Long, SourceData, Data() SourceData = Array("C1", "C2", "", "C3", "C4", "C5", "C6", "E2", "", "E3", "E4", "E5", "E6", "E1", "C7") a = ActiveCell.Row Application.ScreenUpdating = False With Sheet82 'Tao mang luu du lieu dong du lieu active Data() = .Range("A" & a).Resize(, 16) 'Lay cac thong tin tu Data() vao cac o C1, C2,... For I = LBound(SourceData) To UBound(SourceData) If Len(SourceData(I)) Then .Range(SourceData(I)) = Data(1, I + 2) Next I .Range("A1").Value = a End With Application.ScreenUpdating = True End Sub 2/ Đối với Sổ chi tiết giao nhận mẫu, tôi thấy có vấn đề sau: - Ô C7 là Mã ĐVGM/NM nhưng C8 chỉ có ĐVGM - Ở Sheet "nhaplieu" có 3 cột Số lượng nhưng không biết bạn cần lọc cột nào. - Tôi đã viết code lọc cho bạn với điều kiện lấy số liệu cột Số lượng mẫu CB PHP: Sao chép. Sub SochitietGNM() Dim Nhaplieu(), Ketqua() Dim I As Long, J As Long, K As Long Nhaplieu = Sheet82.Range("B9", Sheet82.Range("B9").End(xlDown)).Resize(, 15).Value ReDim Ketqua(1 To UBound(Nhaplieu, 1), 1 To 6) For I = 1 To UBound(Nhaplieu, 1) If Nhaplieu(I, 1) >= Sheet17.Range("D4") And Nhaplieu(I, 1) <= Sheet17.Range("D5") Then If Nhaplieu(I, 2) = Sheet17.Range("C8") Then K = K + 1: Ketqua(K, 1) = K Ketqua(K, 2) = Nhaplieu(I, 15): Ketqua(K, 3) = Nhaplieu(I, 4) Ketqua(K, 4) = Nhaplieu(I, 11): Ketqua(K, 5) = Nhaplieu(I, 6) Ketqua(K, 6) = Nhaplieu(I, 7) End If End If Next I Sheet17.Range("B11:G23").ClearContents If K Then Sheet17.Range("B11").Resize(K, 6) = Ketqua MsgBox "Done", vbInformation, "GPE" Else MsgBox "Khong co du lieu thoa man", vbCritical, "GPE" End If End Sub JungSangAh

JungSangAh

Thành viên mới
Tham gia 2/6/18 Bài viết 43 Được thích 14
vanthinh3101 đã viết: Một số ý kiến 1/ Màn hình bị giật liên tục vì bạn đang thiết lập sự kiện Worksheet_Change, trong khi code Lưu lại có nhiều lần active các ô trong sheet "nhaplieu" Để khắc phục tôi có sửa lại code của bạn như sau: PHP: Sao chép. Sub Lenh_luu_nhaplieu_dasua() Dim SourceData As Variant, DVGM(), DVNM(), GetData(1 To 1, 1 To 16) Dim lR As Long, I As Long Application.ScreenUpdating = False lR = Sheet82.Range("B" & Rows.Count).End(xlUp).Row + 1 'Dong cuoi cot B DVGM = Sheet23.Range("B10", Sheet23.Range("B10").End(xlDown)).Resize(, 2).Value DVNM = Sheet83.Range("B10", Sheet83.Range("B10").End(xlDown)).Resize(, 2).Value SourceData = Array("C1", "C2", "", "C3", "C4", "C5", "C6", "E2", "", "E3", "E4", "E5", "E6", "E1", "C7") 'Dien so thu tu If lR = 9 Then GetData(1, 1) = 1 Else GetData(1, 1) = Sheet82.Range("A" & lR).Offset(-1).Value + 1 End If 'Lay cac thong tin tu cac o C1, C2,... vao mang ket qua For I = LBound(SourceData) To UBound(SourceData) If Len(SourceData(I)) Then GetData(1, I + 2) = Sheet82.Range(SourceData(I)) Next I 'Lay thong tin don vi gui mau For I = 1 To UBound(DVGM, 1) If GetData(1, 3) = DVGM(I, 1) Then GetData(1, 4) = DVGM(I, 2) Exit For End If Next I 'Lay thong tin don vi nhan mau For I = 1 To UBound(DVNM, 1) If GetData(1, 9) = DVNM(I, 1) Then GetData(1, 10) = DVNM(I, 2) Exit For End If Next I 'Gan mang ket qua vao dong cuoi Sheet82.Range("A" & lR).Resize(, 16) = GetData 'Lay thong tin So phieu GM/PT Sheet82.Range("P" & lR) = Left(Sheet82.Range("C" & lR), InStr(Sheet82.Range("C" & lR), "/")) & _ ".T" & Month(Sheet82.Range("B" & lR)) & "/" & _ Format(Application.WorksheetFunction.CountIf(Sheet82.Range("C9:C" & lR), _ Left(Sheet82.Range("C" & lR), InStr(Sheet82.Range("C" & lR), "/")) & "*"), "000") Application.ScreenUpdating = True MsgBox "Da luu du lieu", vbInformation, "GPE" End Sub Tiện viết lại luôn code cho sự kiện Worksheet_Change cho gọn PHP: Sao chép. Sub Lenh_lay_ND_nhaplieu_dasua() Dim a As Long, SourceData, Data() SourceData = Array("C1", "C2", "", "C3", "C4", "C5", "C6", "E2", "", "E3", "E4", "E5", "E6", "E1", "C7") a = ActiveCell.Row Application.ScreenUpdating = False With Sheet82 'Tao mang luu du lieu dong du lieu active Data() = .Range("A" & a).Resize(, 16) 'Lay cac thong tin tu Data() vao cac o C1, C2,... For I = LBound(SourceData) To UBound(SourceData) If Len(SourceData(I)) Then .Range(SourceData(I)) = Data(1, I + 2) Next I .Range("A1").Value = a End With Application.ScreenUpdating = True End Sub 2/ Đối với Sổ chi tiết giao nhận mẫu, tôi thấy có vấn đề sau: - Ô C7 là Mã ĐVGM/NM nhưng C8 chỉ có ĐVGM - Ở Sheet "nhaplieu" có 3 cột Số lượng nhưng không biết bạn cần lọc cột nào. - Tôi đã viết code lọc cho bạn với điều kiện lấy số liệu cột Số lượng mẫu CB PHP: Sao chép. Sub SochitietGNM() Dim Nhaplieu(), Ketqua() Dim I As Long, J As Long, K As Long Nhaplieu = Sheet82.Range("B9", Sheet82.Range("B9").End(xlDown)).Resize(, 15).Value ReDim Ketqua(1 To UBound(Nhaplieu, 1), 1 To 6) For I = 1 To UBound(Nhaplieu, 1) If Nhaplieu(I, 1) >= Sheet17.Range("D4") And Nhaplieu(I, 1) <= Sheet17.Range("D5") Then If Nhaplieu(I, 2) = Sheet17.Range("C8") Then K = K + 1: Ketqua(K, 1) = K Ketqua(K, 2) = Nhaplieu(I, 15): Ketqua(K, 3) = Nhaplieu(I, 4) Ketqua(K, 4) = Nhaplieu(I, 11): Ketqua(K, 5) = Nhaplieu(I, 6) Ketqua(K, 6) = Nhaplieu(I, 7) End If End If Next I Sheet17.Range("B11:G23").ClearContents If K Then Sheet17.Range("B11").Resize(K, 6) = Ketqua MsgBox "Done", vbInformation, "GPE" Else MsgBox "Khong co du lieu thoa man", vbCritical, "GPE" End If End Sub Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh ạ. Anh có thể cho em xin file sau khi a sửa lại code được ko ạ? vì em copy đoạn code này vào sổ CT thì nó ko có cột số lượng và số phiếu anh ạ.. và vì sao sau khi chạy code thì định dạng của nó thay đổi vậy anh? vanthinh3101

vanthinh3101

Thành viên tích cực
Tham gia 24/1/15 Bài viết 1,129 Được thích 1,494 Giới tính Nam Nghề nghiệp Finance
JungSangAh đã viết: Em cảm ơn anh ạ. Anh có thể cho em xin file sau khi a sửa lại code được ko ạ? vì em copy đoạn code này vào sổ CT thì nó ko có cột số lượng và số phiếu anh ạ.. và vì sao sau khi chạy code thì định dạng của nó thay đổi vậy anh? Nhấp chuột vào đây để mở rộng...
Gửi bạn. 2 code sửa lại ở phần cuối cùng của Module NHAPLIEU Code để lọc dữ liệu thì ở Module3

File đính kèm

  • PMKH_2.xlsm PMKH_2.xlsm 1.8 MB · Đọc: 17
JungSangAh

JungSangAh

Thành viên mới
Tham gia 2/6/18 Bài viết 43 Được thích 14
vanthinh3101 đã viết: Gửi bạn. 2 code sửa lại ở phần cuối cùng của Module NHAPLIEU Code để lọc dữ liệu thì ở Module3 Nhấp chuột vào đây để mở rộng...
Em cảm ơn sự giúp đỡ của anh ạ. Chúc anh :)và gia đình một tuần mới vui vẻ ạ. JungSangAh

JungSangAh

Thành viên mới
Tham gia 2/6/18 Bài viết 43 Được thích 14
vanthinh3101 đã viết: Một số ý kiến 1/ Màn hình bị giật liên tục vì bạn đang thiết lập sự kiện Worksheet_Change, trong khi code Lưu lại có nhiều lần active các ô trong sheet "nhaplieu" Để khắc phục tôi có sửa lại code của bạn như sau: PHP: Sao chép. Sub Lenh_luu_nhaplieu_dasua() Dim SourceData As Variant, DVGM(), DVNM(), GetData(1 To 1, 1 To 16) Dim lR As Long, I As Long Application.ScreenUpdating = False lR = Sheet82.Range("B" & Rows.Count).End(xlUp).Row + 1 'Dong cuoi cot B DVGM = Sheet23.Range("B10", Sheet23.Range("B10").End(xlDown)).Resize(, 2).Value DVNM = Sheet83.Range("B10", Sheet83.Range("B10").End(xlDown)).Resize(, 2).Value SourceData = Array("C1", "C2", "", "C3", "C4", "C5", "C6", "E2", "", "E3", "E4", "E5", "E6", "E1", "C7") 'Dien so thu tu If lR = 9 Then GetData(1, 1) = 1 Else GetData(1, 1) = Sheet82.Range("A" & lR).Offset(-1).Value + 1 End If 'Lay cac thong tin tu cac o C1, C2,... vao mang ket qua For I = LBound(SourceData) To UBound(SourceData) If Len(SourceData(I)) Then GetData(1, I + 2) = Sheet82.Range(SourceData(I)) Next I 'Lay thong tin don vi gui mau For I = 1 To UBound(DVGM, 1) If GetData(1, 3) = DVGM(I, 1) Then GetData(1, 4) = DVGM(I, 2) Exit For End If Next I 'Lay thong tin don vi nhan mau For I = 1 To UBound(DVNM, 1) If GetData(1, 9) = DVNM(I, 1) Then GetData(1, 10) = DVNM(I, 2) Exit For End If Next I 'Gan mang ket qua vao dong cuoi Sheet82.Range("A" & lR).Resize(, 16) = GetData 'Lay thong tin So phieu GM/PT Sheet82.Range("P" & lR) = Left(Sheet82.Range("C" & lR), InStr(Sheet82.Range("C" & lR), "/")) & _ ".T" & Month(Sheet82.Range("B" & lR)) & "/" & _ Format(Application.WorksheetFunction.CountIf(Sheet82.Range("C9:C" & lR), _ Left(Sheet82.Range("C" & lR), InStr(Sheet82.Range("C" & lR), "/")) & "*"), "000") Application.ScreenUpdating = True MsgBox "Da luu du lieu", vbInformation, "GPE" End Sub Tiện viết lại luôn code cho sự kiện Worksheet_Change cho gọn PHP: Sao chép. Sub Lenh_lay_ND_nhaplieu_dasua() Dim a As Long, SourceData, Data() SourceData = Array("C1", "C2", "", "C3", "C4", "C5", "C6", "E2", "", "E3", "E4", "E5", "E6", "E1", "C7") a = ActiveCell.Row Application.ScreenUpdating = False With Sheet82 'Tao mang luu du lieu dong du lieu active Data() = .Range("A" & a).Resize(, 16) 'Lay cac thong tin tu Data() vao cac o C1, C2,... For I = LBound(SourceData) To UBound(SourceData) If Len(SourceData(I)) Then .Range(SourceData(I)) = Data(1, I + 2) Next I .Range("A1").Value = a End With Application.ScreenUpdating = True End Sub 2/ Đối với Sổ chi tiết giao nhận mẫu, tôi thấy có vấn đề sau: - Ô C7 là Mã ĐVGM/NM nhưng C8 chỉ có ĐVGM - Ở Sheet "nhaplieu" có 3 cột Số lượng nhưng không biết bạn cần lọc cột nào. - Tôi đã viết code lọc cho bạn với điều kiện lấy số liệu cột Số lượng mẫu CB PHP: Sao chép. Sub SochitietGNM() Dim Nhaplieu(), Ketqua() Dim I As Long, J As Long, K As Long Nhaplieu = Sheet82.Range("B9", Sheet82.Range("B9").End(xlDown)).Resize(, 15).Value ReDim Ketqua(1 To UBound(Nhaplieu, 1), 1 To 6) For I = 1 To UBound(Nhaplieu, 1) If Nhaplieu(I, 1) >= Sheet17.Range("D4") And Nhaplieu(I, 1) <= Sheet17.Range("D5") Then If Nhaplieu(I, 2) = Sheet17.Range("C8") Then K = K + 1: Ketqua(K, 1) = K Ketqua(K, 2) = Nhaplieu(I, 15): Ketqua(K, 3) = Nhaplieu(I, 4) Ketqua(K, 4) = Nhaplieu(I, 11): Ketqua(K, 5) = Nhaplieu(I, 6) Ketqua(K, 6) = Nhaplieu(I, 7) End If End If Next I Sheet17.Range("B11:G23").ClearContents If K Then Sheet17.Range("B11").Resize(K, 6) = Ketqua MsgBox "Done", vbInformation, "GPE" Else MsgBox "Khong co du lieu thoa man", vbCritical, "GPE" End If End Sub Nhấp chuột vào đây để mở rộng...
Anh ơi. Nếu anh không phiền anh có giải thích giúp em code này được ko ạ. Em muốn hiểu nó để áp dụng cho các sheet khác nữa ạ. EM chân thành cảm ơn anh vanthinh3101

vanthinh3101

Thành viên tích cực
Tham gia 24/1/15 Bài viết 1,129 Được thích 1,494 Giới tính Nam Nghề nghiệp Finance
JungSangAh đã viết: Anh ơi. Nếu anh không phiền anh có giải thích giúp em code này được ko ạ. Em muốn hiểu nó để áp dụng cho các sheet khác nữa ạ. EM chân thành cảm ơn anh Nhấp chuột vào đây để mở rộng...
Tôi viết 3 code, code nào bạn cần giải thích. Tôi có viết chỉ dẫn ở code đầu tiên của bài #4 rồi, code thứ 2 thì tương tự code đầu tiên nhưng cách lấy dữ liệu ngược lại. Code thứ 3: PHP: Sao chép. Sub SochitietGNM() Dim Nhaplieu(), Ketqua() Dim I As Long, J As Long, K As Long 'Tao mang chua du lieu tu cot B den cot P trong Sheets("nhap_lieu") Nhaplieu = Sheet82.Range("B9", Sheet82.Range("B9").End(xlDown)).Resize(, 15).Value 'Khai bao kich thuoc mang ket qua ReDim Ketqua(1 To UBound(Nhaplieu, 1), 1 To 6) For I = 1 To UBound(Nhaplieu, 1) 'Kiem tra gia tri cot B trong Sheets("nhap_lieu") co nam trong khoang thoi gian can loc hay khong? If Nhaplieu(I, 1) >= Sheet17.Range("D4") And Nhaplieu(I, 1) <= Sheet17.Range("D5") Then 'Kiem tra gia tri cot C trong Sheets("nhap_lieu") co trung voi C8 trong Sheets("CTGNM") hay khong? If Nhaplieu(I, 2) = Sheet17.Range("C8") Then K = K + 1: Ketqua(K, 1) = K 'Phan tu mang chua so thu tu 'Dien du lieu tuong ung tu Sheets("nhap_lieu") vao mang Ketqua() Ketqua(K, 2) = Nhaplieu(I, 15): Ketqua(K, 3) = Nhaplieu(I, 4) Ketqua(K, 4) = Nhaplieu(I, 11): Ketqua(K, 5) = Nhaplieu(I, 6) Ketqua(K, 6) = Nhaplieu(I, 7) End If End If Next I 'Xoa bo ket qua cu Sheet17.Range("B11:G23").ClearContents If K Then 'Dien ket qua moi Sheet17.Range("B11").Resize(K, 6) = Ketqua MsgBox "Done", vbInformation, "GPE" Else MsgBox "Khong co du lieu thoa man", vbCritical, "GPE" End If End Sub JungSangAh

JungSangAh

Thành viên mới
Tham gia 2/6/18 Bài viết 43 Được thích 14
vanthinh3101 đã viết: Tôi viết 3 code, code nào bạn cần giải thích. Tôi có viết chỉ dẫn ở code đầu tiên của bài #4 rồi, code thứ 2 thì tương tự code đầu tiên nhưng cách lấy dữ liệu ngược lại. Code thứ 3: PHP: Sao chép. Sub SochitietGNM() Dim Nhaplieu(), Ketqua() Dim I As Long, J As Long, K As Long 'Tao mang chua du lieu tu cot B den cot P trong Sheets("nhap_lieu") Nhaplieu = Sheet82.Range("B9", Sheet82.Range("B9").End(xlDown)).Resize(, 15).Value 'Khai bao kich thuoc mang ket qua ReDim Ketqua(1 To UBound(Nhaplieu, 1), 1 To 6) For I = 1 To UBound(Nhaplieu, 1) 'Kiem tra gia tri cot B trong Sheets("nhap_lieu") co nam trong khoang thoi gian can loc hay khong? If Nhaplieu(I, 1) >= Sheet17.Range("D4") And Nhaplieu(I, 1) <= Sheet17.Range("D5") Then 'Kiem tra gia tri cot C trong Sheets("nhap_lieu") co trung voi C8 trong Sheets("CTGNM") hay khong? If Nhaplieu(I, 2) = Sheet17.Range("C8") Then K = K + 1: Ketqua(K, 1) = K 'Phan tu mang chua so thu tu 'Dien du lieu tuong ung tu Sheets("nhap_lieu") vao mang Ketqua() Ketqua(K, 2) = Nhaplieu(I, 15): Ketqua(K, 3) = Nhaplieu(I, 4) Ketqua(K, 4) = Nhaplieu(I, 11): Ketqua(K, 5) = Nhaplieu(I, 6) Ketqua(K, 6) = Nhaplieu(I, 7) End If End If Next I 'Xoa bo ket qua cu Sheet17.Range("B11:G23").ClearContents If K Then 'Dien ket qua moi Sheet17.Range("B11").Resize(K, 6) = Ketqua MsgBox "Done", vbInformation, "GPE" Else MsgBox "Khong co du lieu thoa man", vbCritical, "GPE" End If End Sub Nhấp chuột vào đây để mở rộng...
Dạ vâng. Đây đúng là code em cần anh giúp ạ. Em cảm ơn anh ạ JungSangAh

JungSangAh

Thành viên mới
Tham gia 2/6/18 Bài viết 43 Được thích 14
vanthinh3101 đã viết: Tôi viết 3 code, code nào bạn cần giải thích. Tôi có viết chỉ dẫn ở code đầu tiên của bài #4 rồi, code thứ 2 thì tương tự code đầu tiên nhưng cách lấy dữ liệu ngược lại. Code thứ 3: PHP: Sao chép. Sub SochitietGNM() Dim Nhaplieu(), Ketqua() Dim I As Long, J As Long, K As Long 'Tao mang chua du lieu tu cot B den cot P trong Sheets("nhap_lieu") Nhaplieu = Sheet82.Range("B9", Sheet82.Range("B9").End(xlDown)).Resize(, 15).Value 'Khai bao kich thuoc mang ket qua ReDim Ketqua(1 To UBound(Nhaplieu, 1), 1 To 6) For I = 1 To UBound(Nhaplieu, 1) 'Kiem tra gia tri cot B trong Sheets("nhap_lieu") co nam trong khoang thoi gian can loc hay khong? If Nhaplieu(I, 1) >= Sheet17.Range("D4") And Nhaplieu(I, 1) <= Sheet17.Range("D5") Then 'Kiem tra gia tri cot C trong Sheets("nhap_lieu") co trung voi C8 trong Sheets("CTGNM") hay khong? If Nhaplieu(I, 2) = Sheet17.Range("C8") Then K = K + 1: Ketqua(K, 1) = K 'Phan tu mang chua so thu tu 'Dien du lieu tuong ung tu Sheets("nhap_lieu") vao mang Ketqua() Ketqua(K, 2) = Nhaplieu(I, 15): Ketqua(K, 3) = Nhaplieu(I, 4) Ketqua(K, 4) = Nhaplieu(I, 11): Ketqua(K, 5) = Nhaplieu(I, 6) Ketqua(K, 6) = Nhaplieu(I, 7) End If End If Next I 'Xoa bo ket qua cu Sheet17.Range("B11:G23").ClearContents If K Then 'Dien ket qua moi Sheet17.Range("B11").Resize(K, 6) = Ketqua MsgBox "Done", vbInformation, "GPE" Else MsgBox "Khong co du lieu thoa man", vbCritical, "GPE" End If End Sub Nhấp chuột vào đây để mở rộng...
Em chào anh. Anh làm ơn sửa code file excel này cho em được ko ạ. Em muốn lưu dữ liệu vào các cột H,I,J,K sheet nhap_lieu mà không được anh ạ

File đính kèm

  • VT_DC.xlsm VT_DC.xlsm 182.2 KB · Đọc: 5
vanthinh3101

vanthinh3101

Thành viên tích cực
Tham gia 24/1/15 Bài viết 1,129 Được thích 1,494 Giới tính Nam Nghề nghiệp Finance
JungSangAh đã viết: Em chào anh. Anh làm ơn sửa code file excel này cho em được ko ạ. Em muốn lưu dữ liệu vào các cột H,I,J,K sheet nhap_lieu mà không được anh ạ Nhấp chuột vào đây để mở rộng...
Gửi lại bạn code Lưu. Bạn lưu ý thông tin sheets("VTDC") ở cột B không có dữ liệu liên tiếp. Gặp trường hợp này thì phải tìm dòng cuối bằng cách đi ngược từ dưới lên PHP: Sao chép. Sub Lenh_luu_nhaplieu_dasua() Dim SourceData As Variant, VTDC(), DEAN(), GetData(1 To 1, 1 To 12) Dim lR As Long, I As Long Application.ScreenUpdating = False lR = Sheet82.Range("B" & Rows.Count).End(xlUp).Row + 1 'Dong cuoi cot B VTDC = Sheet23.Range("B10:B" & Sheet23.Range("B" & Rows.Count).End(xlUp).Row).Resize(, 5).Value DEAN = Sheet83.Range("B10", Sheet83.Range("B10").End(xlDown)).Resize(, 5).Value SourceData = Array("", "C1", "C2", "C3", "", "C4", "C5", "", "C6", "", "", "", "") 'Dien so thu tu If lR = 9 Then GetData(1, 1) = 1 Else GetData(1, 1) = Sheet82.Range("A" & lR).Offset(-1).Value + 1 End If 'Lay cac thong tin tu cac o C1, C2,... vao mang ket qua For I = LBound(SourceData) To UBound(SourceData) If Len(SourceData(I)) Then GetData(1, I + 1) = Sheet82.Range(SourceData(I)) Next I 'Lay thong tin don vi nhan mau For I = 1 To UBound(DEAN, 1) If GetData(1, 4) = DEAN(I, 1) Then GetData(1, 5) = DEAN(I, 2) Exit For End If Next I 'Lay thong tin VT_DC For I = 1 To UBound(VTDC, 1) If GetData(1, 7) = VTDC(I, 1) Then GetData(1, 8) = VTDC(I, 2): GetData(1, 10) = VTDC(I, 4) GetData(1, 11) = VTDC(I, 5) Exit For End If Next I 'Tinh thanh tien GetData(1, 12) = GetData(1, 9) * GetData(1, 11) 'Gan mang ket qua vao dong cuoi Sheet82.Range("A" & lR).Resize(, 12) = GetData End Sub Code lấy nội dung nhập liệu ở sự kiện Worksheet_Change bạn viết được rồi. Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

C
  • Question Question
Tự động điền thông tin từ danh sách vào template, nhờ anh chị trợ giúp (1 người xem)
  • chienminhanh
  • Thứ ba lúc 22:19
  • Lập Trình với Excel
Trả lời 2 Đọc 126 Hôm nay lúc 14:13 chienminhanh C katanvn File kiểm đếm phiếu bầu cử 2026-2031 dễ hiểu có kết quả và biên bản (6 người xem)
    • Thích
  • katanvn
  • Thứ tư lúc 13:46
  • Excel Ứng Dụng
Trả lời 2 Đọc 1K Hôm nay lúc 11:07 katanvn katanvn Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024)
    • Thích
  • Nguyễn Duy Tuân
  • 13/9/24
  • BLUESOFTS: A-Excel, A-Tools
Trả lời 67 Đọc 13K Hôm nay lúc 09:48 Nguyễn Duy Tuân Nguyễn Duy Tuân HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động (phiên bản 2026) (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
  • HeSanbi
  • 5/3/21
  • Lập Trình với Excel
Trả lời 87 Đọc 19K Hôm nay lúc 09:23 HeSanbi HeSanbi C
  • Question Question
Tải tin nhắn từ Zalo về Excel
  • cantl
  • 28/8/23
  • Lập Trình với Excel
Trả lời 3 Đọc 2K Hôm nay lúc 09:22 ManhDuy2026 M vova2209
  • Question Question
Co, Dãn dòng vừa trang in
  • vova2209
  • Hôm nay lúc 00:42
  • Lập Trình với Excel
Trả lời 0 Đọc 57 Hôm nay lúc 00:42 vova2209 vova2209 ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
  • ongke0711
  • 6/10/24
  • Lập Trình với Excel
5 6 7 Trả lời 640 Đọc 95K Hôm qua, lúc 21:37 jgdhkkfhkdf J MinhKhai Giúp kết nối từ Excel VBA đến Oracle database. (1 người xem)
  • MinhKhai
  • Thứ tư lúc 17:08
  • Cơ sở dữ liệu
Trả lời 4 Đọc 144 Hôm qua, lúc 18:12 Nguyễn Duy Tuân Nguyễn Duy Tuân SA_DQ Copilot bình luận các ván cờ vua từng ngày.
    • Thích
  • SA_DQ
  • 3/11/25
  • Chia sẻ
Trả lời 88 Đọc 3K Hôm qua, lúc 16:03 SA_DQ SA_DQ H Chào cả nha! Xin tư vấn về câu chuyện quản lý nhân sự
    • Cười
  • hotboykute
  • 22/2/26
  • Những vấn đề chung
Trả lời 15 Đọc 438 Hôm qua, lúc 10:09 yeudoi yeudoi adua29 File Excel kiểm phiếu bầu cử Quốc hội và HĐND các cấp
    • Thích
  • adua29
  • 9/4/21
  • Excel Ứng Dụng
Trả lời 24 Đọc 7K Thứ tư lúc 22:38 doredore1988 D HeSanbi
  • Question Question
Trình điều khiển Web tải hóa đơn điện tử từ trang Misa (actapp.misa.vn/app)
    • Thích
    • Yêu thích
  • HeSanbi
  • 26/2/26
  • Lập Trình với Excel
Trả lời 2 Đọc 281 Thứ tư lúc 17:10 HeSanbi HeSanbi adua29 Gửi tặng file excel kiểm phiếu bầu cử Đại biểu Quốc hội và Hội đồng nhân dân các cấp (1 người xem)
    • Thích
    • Yêu thích
  • adua29
  • 19/5/11
  • Ứng dụng cho lĩnh vực khác
Trả lời 25 Đọc 29K Thứ tư lúc 13:27 NamCT9x N T Chương trình kiểm phiếu bầu cử QH và HĐND các cấp
    • Thích
    • Yêu thích
  • thanhtratt
  • 5/5/21
  • Ứng dụng cho lĩnh vực khác
Trả lời 6 Đọc 2K Thứ tư lúc 11:54 PhanTuHuong PhanTuHuong Cá ngừ F1
  • Question Question
Lấy tỷ giá ngân hàng về file Excel bằng Power Query
  • Cá ngừ F1
  • 13/8/21
  • PowerQuery
Trả lời 11 Đọc 3K Thứ ba lúc 21:35 ptm0412 ptm0412 SA_DQ SodokuX nhờ Copilot trợ giúp
  • SA_DQ
  • Thứ ba lúc 14:14
  • Chơi Game với Excel
Trả lời 0 Đọc 86 Thứ ba lúc 14:14 SA_DQ SA_DQ HeSanbi TaxCode v4.37 - Tra cứu mã số thuế từ tổng cục thuế, masothue và thuvienphapluat
    • Thích
    • Yêu thích
  • HeSanbi
  • 27/11/25
  • Các Add-ins cho excel
Trả lời 21 Đọc 4K Thứ ba lúc 14:05 HeSanbi HeSanbi Nguyễn Duy Tuân
  • Dán lên cao
Phần mềm quản lý kho chuyên nghiệp BS Silver
  • Nguyễn Duy Tuân
  • 1/10/12
  • BLUESOFTS: A-Excel, A-Tools
2 Trả lời 131 Đọc 46K Thứ ba lúc 08:54 Nguyễn Duy Tuân Nguyễn Duy Tuân Maika8008 Sản phẩm từ Python với sự giúp đỡ của Copilot
    • Thích
    • Yêu thích
  • Maika8008
  • 25/2/26
  • Excel và các ngôn ngữ lập trình khác
Trả lời 22 Đọc 661 Thứ hai lúc 13:57 SA_DQ SA_DQ T Xin đoạn code để gửi mail hàng loạt có đính kèm file PDF
  • tuquyen1711
  • Chủ nhật lúc 22:26
  • Macro4.0 và Dialog Sheet 5.0
Trả lời 1 Đọc 153 Thứ hai lúc 09:25 Thóc Sama Thóc Sama Xem thêm… Chia sẻ: Facebook X Bluesky LinkedIn Reddit Pinterest Tumblr WhatsApp Email Chia sẻ Link

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

  • Maika8008 3
  • adua29 3
  • SA_DQ 3
  • HeSanbi 3
  • doredore1988 2
  • MinhKhai 2
  • vova2209 2
  • Nguyễn Duy Tuân 2
  • katanvn 2
  • chienminhanh 2
  • C. Hoa 1
  • ThuyMay93 1
  • Tuanba1992 1
  • fdxfdcfd 1
  • tuquyen1711 1
  • Thóc Sama 1
  • ptm0412 1
  • PhanTuHuong 1
  • NamCT9x 1
  • ManhDuy2026 1

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

  • Maika8008 5
  • adua29 2
  • yeudoi 2
  • SA_DQ 2
  • katanvn 2
  • mafiana 1
  • ThuyMay93 1
  • ptm0412 1
  • doredore1988 1

Thời gian đếm ngược.

000 Ngày 00 Giờ 00 phút 00 giây Thân mời tham dự sự kiện sinh nhật GPE 2025
  • Trang chủ
  • Diễn đàn
  • Những vấn đề chung
  • Website này sử dụng cookies. Tiếp tục sử dụng trang này, đồng nghĩa với việc bạn chấp nhận website sử dụng cookies. Chấp nhận Tìm hiểu thêm.…
Back Top Bottom

Từ khóa » Excel Bị Giật Màn Hình