Xin Code có chức năng giống Code này

  • Thread starter Thread starter khamha
  • Ngày gửi Ngày gửi
Liên hệ QC

khamha

Không có việc gì khó...
Tham gia
4/6/10
Bài viết
662
Được thích
846
Nghề nghiệp
CNVC Laos
Chào các bạn,mình có sử dụng Code này:
Private Sub worksheet_change(ByVal Target As Range)
HS1.Range("A5:E65536").Value = HS.Range("A5:E65536").Value
HS1.Range("F5:F65536").Value = HS.Range("BU5:BU65536").Value
HS2.Range("A5:A65536").Value = HS.Range("C5:C65536").Value
End Sub
để liên kết dữ liệu từ Sheet"HS" ( Sheet"HS" được nhập dữ liệu từ Form ) sang Sheet"HS1" và "HS2" nhưng không hiểu tại sao dung
lượng file nó tăng lên hơn 5 M Và lúc bấm nút Save trong Form thì phải mất 1 phút mới Save xong.
Nhờ các bạn xem và sửa hộ mình cái Code trên hoặc là có Code nào có chức năng tương tự như vậy thì cho mình xin với" nhưng mà phải
nhẹ và chạy nhanh"
Cảm ơn các bạn.
à quên:khi chưa dùng cái Code trên thì file đấy chỉ có 915 kb.
 
Chào các bạn,mình có sử dụng Code này:

để liên kết dữ liệu từ Sheet"HS" ( Sheet"HS" được nhập dữ liệu từ Form ) sang Sheet"HS1" và "HS2" nhưng không hiểu tại sao dung
lượng file nó tăng lên hơn 5 M Và lúc bấm nút Save trong Form thì phải mất 1 phút mới Save xong.
Nhờ các bạn xem và sửa hộ mình cái Code trên hoặc là có Code nào có chức năng tương tự như vậy thì cho mình xin với" nhưng mà phải
nhẹ và chạy nhanh"
Cảm ơn các bạn.
à quên:khi chưa dùng cái Code trên thì file đấy chỉ có 915 kb.
Bạn thử thay câu lệnh
HS1.Range("A5:E65536").Value = HS.Range("A5:E65536").Value
thành câu 2 câu lệnh:
HS.[A5:E65536].Copy : HS1.[A5:E65536].PasteSpecial xlPasteValues
xem liệu có thay đổi gì không (thay thế tương tự cho 2 câu lệnh còn lại). Mình không có dữ liệu thực tế như bạn nên không kiểm chứng được.
 
Upvote 0
Cảm ơn bạn đã giúp,nhưng cách của bạn vẫn không được,nhất là lúc save rất khó chịu
 
Upvote 0
Có thể dữ liệu của bạn 1 vạn dòng, & thử cách này xem sao

PHP:
Option Explicit

Sub FindLastRow()
 Dim LastRow As Long

 LastRow = HS.Cells.Find(What:="*", After:=[A1], _
   SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 HS1.Range("A5:E" & LastRow).Value = HS.Range("A5:E" & LastRow).Value
 HS1.Range("F5:F" & LastRow).Value = HS.Range("BU5:BU" & LastRow).Value
 HS2.Range("A5:A" & LastRow).Value = HS.Range("C5:C" & LastRow).Value

End Sub
 
Upvote 0
Bảng tính mình đang làm và thử nghiệm,nên dữ liệu chỉ có 17 dòng thôi,vì vậy mình mới thắc mắc là khi đưa cái Code ở bài #1 vào thì dung lượng file tăng
lên từ 915 kb thành hơn 5 M.
mịnh đã thử cái Code của bạn rồi mà chả thấy nó hoạt động gì cả,bạn xem lại giúp mình với.Cảm ơn bạn
 
Upvote 0
Bạn thử chạy macro trong file này

--=0 --=0 --=0 --=0 --=0

Tự rút ra kết luận nha!
 

File đính kèm

Upvote 0
Mình thấy cái Code này:
Option ExplicitPrivate Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Not Intersect(Range("A5:E65536"), Target) Is Nothing Then Sheets("HS1").Range("A5:E65536").Value = Range("A5:E65536").Value If Not Intersect(Range("BU5:BU65536"), Target) Is Nothing Then Sheets("HS1").Range("F5:F65536").Value = Range("BU5:BU65536").Value If Not Intersect(Range("C5:C65536"), Target) Is Nothing Then Sheets("HS2").Range("A5:A65536").Value = Range("C5:C65536").Value End Sub

Nó chạy cũng nhanh tầm khoảng 4 giây" Lúc bấm nút Save " nhưng vì dữ liệu của mình chỉ có 17 dòng,nên không biết lúc có
nhiều dữ liệu,liệu nó có chạy ổn định không,Nhờ các bạn kiểm tra giúp với.
 
Upvote 0
Mình thấy cái Code này:
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)  
 Application.ScreenUpdating = False 
 If Not Intersect(Range("A5:E65536"),  Target) Is Nothing Then _
    Sheets("HS1").Range("A5:E65536").Value =  Range("A5:E65536").Value 
2 If Not Intersect(Range("BU5:BU65536"), Target)  Is Nothing Then _
     Sheets("HS1").Range("F5:F65536").Value =  Range("BU5:BU65536").Value 
3  If Not Intersect(Range("C5:C65536"), Target)  Is Nothing Then _
     Sheets("HS2").Range("A5:A65536").Value =  Range("C5:C65536").Value 
End Sub
Nó chạy cũng nhanh tầm khoảng 4 giây" Lúc bấm nút Save " nhưng vì dữ liệu của mình chỉ có 17 dòng,nên không biết lúc có
nhiều dữ liệu,liệu nó có chạy ổn định không,Nhờ các bạn kiểm tra giúp với.

Lấy riêng dòng lệnh có đánh số 2 ra ta thảo luận;

Dòng đó ra lệnh là hễ đụng vô bất kỳ ô nào trong cột 'BU' từ dòng 5 cho đến hết cột thì các ô của cột 'F' thuộc trang tính 'HS1' kể từ [F5] (cho đến hết cột) được gán trị thuộc các ô tương ứng với cột 'BU' của trang tính hiện hành.

Như vậy dù nhiều hay ít dữ liệu tại cột 'BU' (thuộc trang hiện hành) nó cũng fải tiến hành fép gán cho từng ấy ô, mà trong đó không ít những ô trống hơ trống hoát.

Nếu ta áp dùng 1 lệnh, nhờ nó ta tìm ra dòng cuối của cột 'BU' này thì việc sao chép sẽ không làm chuyện vô bổ (Chép những ô trống đến những ô trống)
Nhất là những ô này bạn đã làm gì nó như cánh fải hay canh giữa nguyên cột,. . . thì hỡi ôi. . .

Bạn sẽ thấy viết thêm 1 dòng lệnh đỡ khổ cho máy gần 6 vạn dòng chép vô bổ có hơn hay không. Nếu có thì hãy tìm cách xác định dòng cuối của 'BU' có dữ liệu. (Tham khảo bài tìm LastRow bên trên)

Chúc vui!
 
Upvote 0
Chào bạn HYen17,Mình đưa Code trong bài #4 vào,sao nó không hoạt động,bạn xem lại và giúp mình với.Cảm ơn bạn
Bạn xem mình sửa lại như thế này được chưa,thấy nó chạy nhanh hơn trước.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) [FONT=&quot] [/FONT]Dim LastRow As Long[FONT=&quot]
LastRow [/FONT]
= HS.Cells.Find(What:="*", After:=[A1], _[FONT=&quot]
SearchOrder[/FONT]
:=xlByRows, SearchDirection:=xlPrevious).Row[FONT=&quot]
HS1[/FONT]
.Range("A5:E" & LastRow).Value = HS.Range("A5:E" & LastRow).Value[FONT=&quot]
HS1[/FONT]
.Range("F5:F" & LastRow).Value = HS.Range("BU5:BU" & LastRow).Value[FONT=&quot]
HS2[/FONT]
.Range("A5:A" & LastRow).Value = HS.Range("C5:C" & LastRow).Value[FONT=&quot]
End Sub [/FONT]
 
Lần chỉnh sửa cuối:
Upvote 0
Vậy là ổn rồi đó bạn!

Chào bạn Bạn xem mình sửa lại như thế này được chưa,thấy nó chạy nhanh hơn trước.
Nếu dòng cuối cùng của trang tính 'HS' đều chứa dữ liệu thì OK rồi;

Nếu dòng cuối mỗi vùng copy là khác nhau thì nên xác đình dòng cuôi của từng vùng trước mỗi lần dùng fương thức Copy hay fép gán;

(Như câu lệnh đầu tiên trong macro của bạn LastRow sẽ là dòng cuối có dữ liệu của trang tính;
Cũng có thể dòng cuối của vùng thuộc cột 'A:E' khác nhiều với dòng cuối có dữ liệu của cột 'BU' thì ta nên xác định lại LastRow trước khi copy cột 'BU' này.

Vậy thôi! --=0 --=0 --=0
 
Upvote 0
Web KT

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

Back
Top Bottom