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,809 Được thích 6,368 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

huuthang_bd Cùng xây dựng file Gia Phả (2 người xem)
    • Thích
  • huuthang_bd
  • 30/12/13
  • Xây dựng ứng dụng.
Trả lời 37 Đọc 21K 44 phút trước Maika8008 Maika8008 P Tìm giá trị tồn kho đầu ngày (1 người xem)
  • ptthuongtn
  • Hôm qua, lúc 15:15
  • Hàm và công thức Excel
Trả lời 2 Đọc 77 Hôm nay lúc 08:21 ptthuongtn P K Các nút Buttom, Combobox, Textbox bị thay đổi kích thước ... (1 người xem)
  • kaoehtkid
  • Thứ hai lúc 19:04
  • Những vấn đề chung
Trả lời 6 Đọc 150 Hôm qua, lúc 18:40 ptm0412 ptm0412 M Sai lệch vùng dữ liệu khi tạo Name Range bằng VBA
    • Buồn
  • Mr_Siro
  • Hôm qua, lúc 10:57
  • Giải thích, gỡ rối, xử lý lỗi công thức
Trả lời 4 Đọc 89 Hôm qua, lúc 17:38 SA_DQ SA_DQ Nguyenkhang2404 Tính định mức sản phẩm
    • Chấp nhận
  • Nguyenkhang2404
  • 24/7/25
  • Hàm và công thức Excel
Trả lời 10 Đọc 835 Hôm qua, lúc 15:54 thaodang88 T skygatevn Xin giúp đỡ về việc áp dụng hàm phù hợp để phân tách dữ liệu
  • skygatevn
  • Hôm qua, lúc 11:59
  • Hướng dẫn sử dụng các hàm trong Excel
Trả lời 3 Đọc 72 Hôm qua, lúc 13:52 skygatevn skygatevn PhanTuHuong Bán sách Excel nâng cao để ủng hộ đồng bào bão lũ năm 2025!
    • Yêu thích
  • PhanTuHuong
  • 10/12/25
  • Câu lạc bộ hoạt động xã hội
Trả lời 5 Đọc 292 Hôm qua, lúc 12:43 GPE-Trợ Lý GPE-Trợ Lý D Xin giúp.......Kết hợp countifs và Sumproduct để đếm dữ liệu và tính số lượng tổng không trùng lặp với nhiều điều kiện (1 người xem)
  • dieppk.nb92
  • Chủ nhật lúc 01:22
  • Hàm và công thức Excel
Trả lời 14 Đọc 380 Hôm qua, lúc 10:20 dieppk.nb92 D PhanTuHuong Nếu diễn đàn GPE đóng cửa?
    • Thích
    • Yêu thích
  • PhanTuHuong
  • Chủ nhật lúc 23:46
  • Thư giãn
Trả lời 17 Đọc 519 Hôm qua, lúc 09:21 anhtuanle123 A GPE-Trợ Lý CHUNG TAY HƯỚNG VỀ MIỀN TRUNG NĂM 2025
    • Thích
  • GPE-Trợ Lý
  • 24/11/25
  • Câu lạc bộ hoạt động xã hội
Trả lời 12 Đọc 849 Hôm qua, lúc 07:38 PhanTuHuong PhanTuHuong HeSanbi
  • Đã giải quyết
WeatherXL - Ứng dụng lấy dữ liệu Thời tiết siêu nhanh (***Đang phát triển lại)
    • Thích
    • Yêu thích
  • HeSanbi
  • 30/5/20
  • Lập Trình với Excel
Trả lời 92 Đọc 27K Thứ ba lúc 19:57 Maika8008 Maika8008 P Lỗi hàm VBA phải add-in sau mỗi lần mở file
  • phamdinh.huy.aladin@gmail
  • Thứ hai lúc 10:18
  • Hàm và công thức Excel
Trả lời 5 Đọc 159 Thứ ba lúc 13:59 phamdinh.huy.aladin@gmail P D
  • Question Question
Tách dòng tự động theo điều kiện bằng VBA
    • Cười
  • duongnhuxuyen
  • Thứ sáu lúc 15:39
  • Lập Trình với Excel
Trả lời 14 Đọc 302 Thứ ba lúc 09:00 ptm0412 ptm0412 ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
  • ongke0711
  • 6/10/24
  • Lập Trình với Excel
4 5 6 Trả lời 580 Đọc 83K Thứ ba lúc 08:39 pycckuu410 pycckuu410 E
  • Đã giải quyết
VBA code thay thế cho pivot-table lấy top 10, bottom 10
    • Thích
  • eagle12
  • 8/12/25
  • Lập Trình với Excel
Trả lời 24 Đọc 542 Thứ hai lúc 16:19 eagle12 E HeSanbi Thuật ngữ "Đối chiếu Unicode" quan trọng trong việc xử lý chuỗi ký tự
  • HeSanbi
  • Thứ bảy lúc 15:41
  • Xử lý chuỗi ký tự
Trả lời 1 Đọc 164 Thứ hai lúc 10:34 jonythanht J H tìm kiếm nội dung liên kết giữa cac bảng , cac sheet trong excel
  • H_P
  • Thứ bảy lúc 14:23
  • Tìm kiếm, dò tìm và tham chiếu
Trả lời 2 Đọc 131 Thứ hai lúc 05:30 DeTong D N Công thức trích xuất riêng các ký tự trong chuỗi họ tên
  • Ngựa con 2002
  • Thứ bảy lúc 23:07
  • Xử lý chuỗi ký tự
Trả lời 7 Đọc 170 Chủ nhật lúc 18:57 Ngựa con 2002 N Q Nhờ các chị cho em xin công thức đếm bản ghi loại bỏ dữ liệu trùng lặp với nhiều điều kiện
  • QUANSUNG
  • Thứ bảy lúc 10:55
  • Hàm và công thức Excel
Trả lời 2 Đọc 153 Chủ nhật lúc 00:02 dungpham01 D D Công thức tính thuế thu nhập cá nhân mới nhất theo mức 5 bậc (1 người xem)
  • Dinh Hong Nhung
  • 11/12/25
  • Hàm và công thức Excel
Trả lời 14 Đọc 826 Thứ bảy lúc 10:43 Cúc Hr C 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 34
  • thanthanhan 22
  • dungpham01 19
  • eagle12 16
  • ongke0711 16
  • nguyenanhtruong2409 14
  • ptm0412 14
  • Phan Thế Hiệp 13
  • HUONGHCKT 12
  • vic_it 11
  • nhhnam 10
  • pycckuu410 10
  • Vũ Hải Sơn 9
  • HeSanbi 8
  • dieppk.nb92 8
  • bsbnhh 7
  • Gà Con yêu VBA 7
  • Hana2610 6
  • duongnhuxuyen 6
  • Mr.hieudoanxd 5

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

  • Phan Thế Hiệp 63
  • Maika8008 26
  • thanthanhan 18
  • ongke0711 17
  • ptm0412 15
  • HeSanbi 12
  • dungpham01 11
  • HUONGHCKT 9
  • eagle12 9
  • Cúc Hr 8
  • dieppk.nb92 6
  • befaint 5
  • Mr.hieudoanxd 5
  • pycckuu410 5
  • Phuocam 4
  • nguyenanhtruong2409 4
  • SA_DQ 4
  • nhhnam 2
  • Gà Con yêu VBA 2
  • huuthang_bd 2

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