Hoàn thiện code cập nhật dữ liệu

  • 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
Em muốn sửa dùm em code cho Sheet "NKC" sao cho có thêm thông tin như: Ngày tháng, người lập sổ, giám đốc,...
Vì code hiện tại chỉ cập nhật những dữ liệu phát sinh. Và khi in thì phải có thêm thông tin như: Ngày tháng, người lập sổ, giám đốc,... nữa chứ!?
Em rất mong các anh chị xem rồi góp ý thêm và sửa dùm cho em nhé!
 

File đính kèm

A/C ơi hướng dẫn dùm em với! Quả thực em cung đang cần để nộp báo cáo đó!
 
Upvote 0
Bạn cần làm các việc sau đây

(1) Thêm đoạn Code này vô trong macro thuộc nút lệnh đó:

Mã:
    n = [A65500].End(xlUp).Row + 3
    With Cells(n - 1, "H")
      .FormulaR1C1 = "=NgayVN"
      .Font.Name = "Tahoma":        .Font.Size = 12
    End With
    With Cells(n, "B")
      .FormulaR1C1 = "=NgLap":      .Font.Bold = True
    End With
    With Cells(n, "h")
      .FormulaR1C1 = "=GDoc":      .Font.Bold = True
    End With
[COLOR=silver]   Application.ScreenUpdating = True[/COLOR]
[COLOR=silver]End Sub[/COLOR]

(2) Thêm các tên như yêu cầu.
Ở đây mình hướng dẫn kỹ cách tạo tên NgayVN; Các tên kia nhường cho bạn thử sức:
(*) Vo menu Insert => Name => Define. . . .
Khi CS (cửa sổ) Dèine Name xuất hiện ta nhập NgayVN trong ngăn 'Names in workbook
Trong ngăn Refers to: ta nhập dòng:
="Ngày " & RIGHT("0" & DAY(TODAY()),2) & " Tháng " & RIGHT("0" & MONTH(TODAY()),2) & "năm " & YEAR(TODAY()) & "."

Sau đó ấn nút nào đó bạn đã biết để name này tồn tại như những names khác 1 cách bình thường
(*) ( Nhắc lại: Bạn tự làm thêm 2 names nữa mà fần thêm của macro đang iêu cầu - Nếu không macro sẽ báo lỗi)

Thử chạy macro xem sao

Chúc thành công; Nhưng cũng khuyên bạn 1 điều: Các biến trong macro cần khai tường minh. Sau này đỡ tốn công bảo trì & sửa chỉnh macro!
 
Upvote 0
(1) Thêm đoạn Code này vô trong macro thuộc nút lệnh đó:

Mã:
n = [A65500].End(xlUp).Row + 3
With Cells(n - 1, "H")
.FormulaR1C1 = "=NgayVN"
.Font.Name = "Tahoma": .Font.Size = 12
End With
With Cells(n, "B")
.FormulaR1C1 = "=NgLap": .Font.Bold = True
End With
With Cells(n, "h")
.FormulaR1C1 = "=GDoc": .Font.Bold = True
End With
[COLOR=silver]Application.ScreenUpdating = True[/COLOR]
[COLOR=silver]End Sub[/COLOR]

(2) Thêm các tên như yêu cầu.
Ở đây mình hướng dẫn kỹ cách tạo tên NgayVN; Các tên kia nhường cho bạn thử sức:
(*) Vo menu Insert => Name => Define. . . .
Khi CS (cửa sổ) Dèine Name xuất hiện ta nhập NgayVN trong ngăn 'Names in workbook
Trong ngăn Refers to: ta nhập dòng:
="Ngày " & RIGHT("0" & DAY(TODAY()),2) & " Tháng " & RIGHT("0" & MONTH(TODAY()),2) & "năm " & YEAR(TODAY()) & "."

Sau đó ấn nút nào đó bạn đã biết để name này tồn tại như những names khác 1 cách bình thường
(*) ( Nhắc lại: Bạn tự làm thêm 2 names nữa mà fần thêm của macro đang iêu cầu - Nếu không macro sẽ báo lỗi)

Thử chạy macro xem sao

Chúc thành công; Nhưng cũng khuyên bạn 1 điều: Các biến trong macro cần khai tường minh. Sau này đỡ tốn công bảo trì & sửa chỉnh macro!

HYen17 ơi, mình đã làm theo cách của bạn thì được rồi. Nhưng có 1 vđề nho nhỏ thể này mong bạn sửa lại code dùm cho mình nhé!
Giả sử: Bên Sheet DATA mình bỏ bớt dữ liệu đi nhé khi mình chọn nút Tạo sổ thì thông tin như: NgayVN, NgLap, GDoc sao nó không tự động thay đổi vị trí?
Ý mình muốn hỏi phải sửa đoạn code như thế nào nếu giả thiết trường hợp dữ liệu ít hoặc nhiều hơn thì nó sẽ xoá NgayVN, NgLap, GDoc ở vị trí cũ đi và hiện ở chỗ mới phù hợp.
Đây là code mình sửa theo HYen17 đó:

PHP:
Sub LocSo205()
    Set SNguon = Sheets("DATA")
    Set SDich = Sheets("NKC")
    On Error Resume Next
    Application.ScreenUpdating = False
    n = SDich.Range("I65000").End(xlUp).Row
    SDich.Range("A12:I" & n).ClearContents
    m = SNguon.Range("I65000").End(xlUp).Row
    SNguon.Range("A12:I" & m).Copy Destination:=SDich.Range("A12")
    With SDich
        n = .Range("I65000").End(xlUp).Row
        For i = 12 To n
            If .Range("B" & i) = .Range("B" & i - 1) Then
                .Range("A" & i & ":C" & i) = ""
         End If
        Next
    End With
    n = [A65500].End(xlUp).Row + 3
    With Cells(n - 1, "H")
      .FormulaR1C1 = "=NgayVN"
      .Font.Name = "Tahoma":        .Font.Size = 11
    End With
    With Cells(n, "B")
      .FormulaR1C1 = "=NgLap":      .Font.Bold = True
      .Font.Name = "Times New Roman":        .Font.Size = 13
    End With
    With Cells(n, "h")
      .FormulaR1C1 = "=GDoc":      .Font.Bold = True
      .Font.Name = "Times New Roman":        .Font.Size = 13
    End With
    Application.ScreenUpdating = True
End Sub

HYen17 kiểm tra và sửa lại cho mình nhé!
 

File đính kèm

Upvote 0
Đoạn code của em thêm cài này nữa là Ok

PHP:
 SDich.Range("A65500:I" & n + 3).ClearContents

Như vậy, có ổn không A/C?
 
Upvote 0
HYen17 ơi, mình đã làm theo cách của bạn thì được rồi. Nhưng có 1 vđề nho nhỏ thể này mong bạn sửa lại code dùm cho mình nhé!
Giả sử: Bên Sheet DATA mình bỏ bớt dữ liệu đi nhé khi mình chọn nút Tạo sổ thì thông tin như: NgayVN, NgLap, GDoc sao nó không tự động thay đổi vị trí?
Ý mình muốn hỏi phải sửa đoạn code như thế nào nếu giả thiết trường hợp dữ liệu ít hoặc nhiều hơn thì nó sẽ xoá NgayVN, NgLap, GDoc ở vị trí cũ đi và hiện ở chỗ mới phù hợp.
Đây là code mình sửa theo HYen17 đó:

PHP:
Sub LocSo205()
Set SNguon = Sheets("DATA")
Set SDich = Sheets("NKC")
On Error Resume Next
Application.ScreenUpdating = False
n = SDich.Range("I65000").End(xlUp).Row
SDich.Range("A12:I" & n).ClearContents
m = SNguon.Range("I65000").End(xlUp).Row
SNguon.Range("A12:I" & m).Copy Destination:=SDich.Range("A12")
With SDich
n = .Range("I65000").End(xlUp).Row
For i = 12 To n
If .Range("B" & i) = .Range("B" & i - 1) Then
.Range("A" & i & ":C" & i) = ""
End If
Next
End With
n = [A65500].End(xlUp).Row + 3
With Cells(n - 1, "H")
.FormulaR1C1 = "=NgayVN"
.Font.Name = "Tahoma": .Font.Size = 11
End With
With Cells(n, "B")
.FormulaR1C1 = "=NgLap": .Font.Bold = True
.Font.Name = "Times New Roman": .Font.Size = 13
End With
With Cells(n, "h")
.FormulaR1C1 = "=GDoc": .Font.Bold = True
.Font.Name = "Times New Roman": .Font.Size = 13
End With
Application.ScreenUpdating = True
End Sub

HYen17 kiểm tra và sửa lại cho mình nhé!
Bạn thêm
Range("A" & n & ":I" & n + 20).ClearContents
dưới hàng "n = [A65500].End(xlUp).Row + 3"xem thử nhé
 
Upvote 0
Chuyện này liên quan đến 3 dòng lệnh sau đây của bạn:

PHP:
    n = SDich.Range("I65000").End(xlUp).Row
    SDich.Range("A12:I" & n).ClearContents
    m = SNguon.Range("I65000").End(xlUp).Row

(1) n sẽ là hàng cuối chứa dữ liệu của cột 'I'; Nhưng hàng cuối chứa dữ liệu của trang tính sẻ là ở cột 'H' (Cột có chứa 'GIÁM ĐỐC' của lần chạy macro trước kề đó suông sẻ.
Như vậy chắc ăn là dòng lệnh thứ 2 nên viết là
PHP:
    SDich.Range("A12:I" & n+9).ClearContents

Tiếc công tiếc của gì mà không cho nó xóa thêm vài dòng nữa vậy?
Còn nếu bạn hỏi sao là con số 9 ư?; Dễ mà, là số lớn nhứt của các số có 1 chữ số!

(2) Chắc ăn hơn nữa, ta nên dùng chuyện xóa luôn format cũ bằng câu lậnh ngắn hơn tẹo, đó là

PHP:
    SDich.Range("A12:I" & n+9).Clear

Bạn tự ngẫm xem tại sao mình đề xuất như vậy. Mình không xúi dại bạn đâu nha!
Mình đang xúi khôn bạn đó & chúc thành công!






 
Upvote 0
Mọi người tìm dùm em chỗ sai của đoạn code này nhé! Không hiểu em làm nó vẫn báo lỗi

PHP:
Sub LocSo205()
    Set SNguon = Sheets("DATA")
    Set SDich = Sheets("NKC")
    On Error Resume Next
    Application.ScreenUpdating = False
    n = SDich.Range("I65000").End(xlUp).Row
    SDich.Range("A12:I" & n).ClearContents
    m = SNguon.Range("I65000").End(xlUp).Row
    SNguon.Range("A12:I" & m).Copy Destination:=SDich.Range("A12")
    With SDich
        n = .Range("I65000").End(xlUp).Row
        For i = 12 To n
            If .Range("B" & i) = .Range("B" & i - 1) Then
                .Range("A" & i & ":C" & i) = ""
         End If
    Next
    n = [A65500].End(xlUp).Row + 3
    Range("A" & n & ":I" & n + 20).ClearContents
    'SDich.Range("A65500:I" & n + 5).ClearContents  'Them cai nay la duoc dung khong ah!
    With Cells(n, "D")
      .FormulaR1C1 = "=Cong"
      .Font.Name = "Times New Roman":        .Font.Size = 11
  '   .HorizontalAlignment = xlCenter
    End With
    With Cells(n, "B")
      .FormulaR1C1 = "=NgGhi":      .Font.Bold = True
      .Font.Name = "Times New Roman":        .Font.Size = 13
 '     .HorizontalAlignment = xlCenter
    End With
    With Cells(n, "E")
      .FormulaR1C1 = "=KTT":      .Font.Bold = True
      .Font.Name = "Times New Roman":        .Font.Size = 13
    End With
    With Cells(n, "H")
      .FormulaR1C1 = "=GD":      .Font.Bold = True
      .Font.Name = "Times New Roman":        .Font.Size = 13
'      .HorizontalAlignment = xlCenter
    End With
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hãy dùng fím {TaB} để thụt đầu dòng các dòng lệnh

Nếu đã vậy, đâu đến nổi gặp lỗi sơ đẵng vầy:

Thiếu dòng lệnh End With tại 1 trong 2 chổ sau:

1./ Từ dòng lệnh đánh số 1 đến số 4

2./ Dòng lệnh số 5


PHP:
Sub LocSo205()
    Set SNguon = Sheets("DATA")
    Set SDich = Sheets("NKC")
    On Error Resume Next
    Application.ScreenUpdating = False
    n = SDich.Range("I65000").End(xlUp).Row
    SDich.Range("A12:I" & n).ClearContents
    m = SNguon.Range("I65000").End(xlUp).Row
    SNguon.Range("A12:I" & m).Copy Destination:=SDich.Range("A12")
    With SDich
        n = .Range("I65000").End(xlUp).Row
        For i = 12 To n
            If .Range("B" & i) = .Range("B" & i - 1) Then
                .Range("A" & i & ":C" & i) = ""
            End If
1         Next
         n = [A65500].End(xlUp).Row + 3
         Range("A" & n & ":I" & n + 20).ClearContents
4
    'SDich.Range("A65500:I" & n + 5).ClearContents ; Them cai nay la duoc dung khong ah!
         With Cells(n, "D")
            .FormulaR1C1 = "=Cong"
            .Font.Name = "Times New Roman":        .Font.Size = 11
  '   .HorizontalAlignment = xlCenter
         End With
         With Cells(n, "B")
            .FormulaR1C1 = "=NgGhi":      .Font.Bold = True
            .Font.Name = "Times New Roman":        .Font.Size = 13
 '     .HorizontalAlignment = xlCenter
         End With
         With Cells(n, "E")
            .FormulaR1C1 = "=KTT":      .Font.Bold = True
            .Font.Name = "Times New Roman":        .Font.Size = 13
         End With
         With Cells(n, "H")
            .FormulaR1C1 = "=GD":      .Font.Bold = True
            .Font.Name = "Times New Roman":        .Font.Size = 13
'      .HorizontalAlignment = xlCenter
         End With
    Application.ScreenUpdating = True
5
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom