Sửa lại code

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

NH_DK

Let's patience
Tham gia
29/7/10
Bài viết
865
Được thích
1,203
Nghề nghiệp
Kế toán
A/C ơi, em có ví dụ này em làm nhưng vẫn chưa được hoàn chỉnh. A/C xem và hoàn thiện dùm em nhé!
 

File đính kèm

Code của em đây:

Mã:
Sub vidu()
Application.ScreenUpdating = False
    n = Sheet2.Range("F65000").End(xlUp).Row
    If n < 7 Then n = 7
    Sheet2.Range("A7:F" & n).ClearContents
    m = Sheet1.Range("F65000").End(xlUp).Row
    Sheet1.Range("A2:F" & m).Copy Destination:=Sheet2.Range("A7")
        With Sheet2
        n = .Range("F65000").End(xlUp).Row
           For i = 8 To n
            If .Range("A" & i) = .Range("A" & i - 1) Then
                .Range("A" & i) = ""
            End If
            Next
        End With
        
End Sub

Lưu ý không lạm dụng các biến đối tượng nha. Chỉ sử dụng khi thật cần thiết, sử dụng xong phải xoá bỏ nó.
 
Upvote 0
A/C ơi, em có ví dụ này em làm nhưng vẫn chưa được hoàn chỉnh. A/C xem và hoàn thiện dùm em nhé!
đoạn code của bác ;
PHP:
Application.ScreenUpdating = False
    n = SDich.Range("F65000").End(xlUp).Row
    SDich.Range("A7:F" & n).ClearContents
bác sửa lại dòng này thành;

PHP:
Application.ScreenUpdating = False
    n = SDich.Range("f7", [f65536]).End(xlDown).Row
    SDich.Range("A7:F" & n).ClearContents
 
Upvote 0
Code của em đây:

Mã:
Sub vidu()
Application.ScreenUpdating = False
n = Sheet2.Range("F65000").End(xlUp).Row
If n < 7 Then n = 7
Sheet2.Range("A7:F" & n).ClearContents
m = Sheet1.Range("F65000").End(xlUp).Row
Sheet1.Range("A2:F" & m).Copy Destination:=Sheet2.Range("A7")
With Sheet2
n = .Range("F65000").End(xlUp).Row
For i = 8 To n
If .Range("A" & i) = .Range("A" & i - 1) Then
.Range("A" & i) = ""
End If
Next
End With
 
End Sub

Lưu ý không lạm dụng các biến đối tượng nha. Chỉ sử dụng khi thật cần thiết, sử dụng xong phải xoá bỏ nó.

Anh ơi, anh sửa lại dùm em một chút nữa nhé! Kết quả cuối cùng phải được như chỗ tô màu đó anh?
 

File đính kèm

Upvote 0
Anh ơi, anh sửa lại dùm em một chút nữa nhé! Kết quả cuối cùng phải được như chỗ tô màu đó anh?

Dùng đoạn CODE sau xem thế nào.
PHP:
Sub GPE()
Application.ScreenUpdating = False
    [a6].CurrentRegion.ClearContents
    Sheet1.[a1].CurrentRegion.Copy Destination:=[a6]
Set data = [a6].CurrentRegion
    data.Sort key1:=[a6], header:=1
    For i = data.Rows.Count To 2 Step -1
        If [a6].Offset(i) = [a6].Offset(i - 1) Then [a6].Offset(i) = Empty
    Next
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Vì bạn đưa bài lên "Trung tâm giải thích Code", nên mình sẽ giải thích code của bạn

Đây là Code của bạn:
PHP:
'Option Explicit'

Sub vidu()
'Dim SDich, SNguon As Range'
'Dim n, m, i As Long'
1 Set SDich = Sheets("DATA2")
Set SNguon = Sheets("DATA1")
3 Application.ScreenUpdating = False
    n = SDich.Range("F65000").End(xlUp).Row
5    SDich.Range("A7:F" & n).ClearContents
    m = SNguon.Range("F65000").End(xlUp).Row
7    SNguon.Range("A2:F" & m).Copy Destination:=SDich.Range("A7")
        With SDich
9        n = SDich.Range("F65000").End(xlUp).Row
            For i = 8 To n
11            If .Range("A" & i) = .Range("A" & i - 1) Then
                .Range("A" & i) = ""
13            End If
            Next
15        End With        
End Sub

(Mình đã thêm mấy dáu nháy cuói dòng lệnh để dễ nhìn;
Mình thêm số vô dòng lệnh để dễ tranh luận với bạn, khì, khì,. . . )

(*) Với những người tự học VBA như chúng ta, luôn nên sử dụng Option Explicit
Điều này khiến ta có thói quen tốt trong quản lý các biến khai báo & tránh sai chính tả khi nhập các dòng lệnh;

(*) Chỉ nên khai báo 1 biến đối tượng, Vì trong macro ta xoay quanh 2 trang tính, ta nên đứng ở 1 trang tính (Bằng fươpng thức .Select) ; Còn trang kia ta gán vô biến đối tượng; Biến này nên khai là Dim Sh As WorkSheet
- Càng tường minh càng tiến xa bạn à!)

(*) Không nên khai báo kiểu Dim n, m, i As Long;
Mà nên là Dim n As Long, m As Long, i As Long ; Sự lặp lại ở đây gây cho ta 1 nhàm chán nào đó, nhưng nó là cần thiết của tính cách 1 lập trình viên khởi sự đúng đắn, & xem vô code người ta không nói rằng: "Mới tí mà đã kêu ngạo"

Còn bạn than fiền chủ yếu là sao nó xóa luôn dòng tiêu đề của bạn ư?
Khi xuất fát từ dòng 7 bạn đi tìm dòng cuối; Nếu dòng cuối là dòng 6, thì bạn ra lệnh xóa từ dòng 7 đến dòng cuối;
Thì nó không ngu gì không xóa dòng 7 đến dòng 6;
Muốn nó khôn hơn, ta fải nêu điều kiện; Đó là dòng cuối > 7 hãy xóa dữ liệu;


(Còn 1 vài việc nữa muốn trao đổi cùng bạn những điều khó nghe, nhưng mình có cuộc hẹn rồi. Hẹn dịp khác sẽ nhiều lời hơn!)


Chúc thắng lợi!
 
Upvote 0
Anh ơi, anh sửa lại dùm em một chút nữa nhé! Kết quả cuối cùng phải được như chỗ tô màu đó anh?

Bạn đổi
PHP:
For i = 8 To n
thành
PHP:
For i = n To 8 step -1
là được.
File mình record bạn sửa lại thêm nhé (có them sort)
 

File đính kèm

Upvote 0
Bạn đổi
PHP:
For i = 8 To n
thành
PHP:
For i = n To 8 step -1
là được.
File mình record bạn sửa lại thêm nhé (có them sort)

Bạn làm ngược hay xuôi chả có gì ảnh hưởng cả.
Bạn cho i chạy về đến 8. Vậy dòng 7 không xóa để nó làm gián điệp sao (Cách của bạn là bỏ lại 1 dòng cho chắc ăn, nhưng nhỡ 1 ngày nào đó cái chữ Ngày trên tiêu đề biến mất thì toi)

Cái vấn đề chính gây ra mất tiêu đề ở đây là khi không có dữ liệu thì dòng đầu tiên có dữ liệu là dòng tiêu đề (Dòng 6) --->Vùng xóa sẽ là Dòng 6 đến Dong 7-->Tiêu đề mất
Để chắc ăn kể cả khi vô tình tiêu đề mất chữ Ngày thì sau khi gán n xong ta thêm
If n<7 then n=7

P/s: Code để xóa ngày như sau:

Mã:
Sub vidu()
Dim n As Long, luu As Date
 Application.ScreenUpdating = False
  n = Sheet2.Range("F65000").End(xlUp).Row
    If n < 7 Then n = 7
     Sheet2.Range("A7:F" & n).ClearContents
      m = Sheet1.Range("F65000").End(xlUp).Row
       Sheet1.Range("A2:F" & m).Copy Destination:=Sheet2.Range("A7")
        With Sheet2
        n = .Range("F65000").End(xlUp).Row
   For i = 7 To n
    If luu <> .Cells(i, 1) Then
     luu = .Cells(i, 1)
       Else
        .Cells(i, 1) = ""
         End If
          Next
           End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom