Tự động trích ngang dữ liệu trong Excel (3 người xem)

Liên hệ QC

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

handung107

Thành viên gắn bó
Thành viên danh dự
Tham gia
30/5/06
Bài viết
1,630
Được thích
17,442
Nghề nghiệp
Bác sĩ
Trần Xuân Thiên​

txthientx@fastmail.fm
Công ty may Trường Giang - Quảng Nam​

Bạn được giao nhiệm vụ thực hiện một biểu dữ liệu chi tiết theo dạng bàn cờ như nhật ký chứng từ. Nhập liệu bằng tay cho biểu này phải dùng scroll bar kéo qua kéo lại để tìm cho đúng cột dữ liệu, vừa tốn công vừa dễ nhầm. Chi bằng bạn cứ nhập các thông tin cần thiết, phần việc còn lại hãy cứ để cho Excel làm giúp, đảm bảo số liệu chính xác 100%.

Ví dụ, chúng ta có một mẫu nhật ký chi tiền mặt (hình 1) với quy ước nhập liệu là nếu một chứng từ có nhiều tài khoản đối ứng thì nhập trên nhiều dòng khác nhau nhưng các cột ngày, số chứng từ và nội dung phải giống nhau. Nhiệm vụ được chia nhỏ thành 3 thủ tục macro để tiện cho việc bảo trì, sửa đổi mã lệnh sau này khi cần thiết (xin được bỏ qua bước trình bày cách tạo, lưu giữ và quản lý module, các thao tác này khá đơn giản). Một số điểm cần lưu ý trước khi trình bày mã lệnh của các thủ tục:

- Để gán giá trị của một cell vào biến, hãy di chuyển đến cell này và dùng thuộc tính value của cell hiện hành gán cho biến đã khai báo (Bien=ActiveCell.Value). Xong các lệnh gán, nhớ quay trở về cell cũ trước khi di chuyển.

- Sử dụng địa chỉ kiểu tương đối khi di chuyển cell bằng thuộc tính Offset (Offset(Row, Column)).

- Dùng một macro thứ tư gọi lần lượt 3 macro trên để hình thành một quá trình hoàn chỉnh, gán phím tắt cho macro này để tiện sử dụng.

1. Trích ngang dữ liệu theo tài khoản phát sinh. Trong thủ tục này, căn cứ vào số hiệu tài khoản tại cột TK, số tiền tương ứng được trải ra theo chiều ngang, tiền của tài khoản nào được điền vào cột mang đúng số hiệu tài khoản đó.

Sub TrichNgang()

Dim Taikhoan As String

Dim ThutuDong, SoCot As Integer

Dim Sotien As Long

Range(“D2”).Select

Lặp đến dòng cuối của danh sách

Do Until ActiveCell.Value = “”

Taikhoan = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Sotien = ActiveCell.Value

Range(“F1”).Select

SoCot = 2

Thực hiện cho đến cột tài khoản cuối cùng. Nếu tìm thấy số hiệu tài khoản
thì điền số tiền lên dòng trên cùng của chứng từ và thoát vòng lặp.

Do Until ActiveCell.Value = “”

If ActiveCell.Value = Taikhoan Then

ActiveCell.Offset(ThutuDong + 1, 0).Range(“A1”).Select

ActiveCell.Value = Sotien

Exit Do

Else

ActiveCell.Offset(0, 1).Range(“A1”).Select

End If

SoCot = SoCot + 1

Loop

Trường hợp không tìm thấy tài khoản thì điền số hiệu tài khoản vào cột cuối cùng và điền số tiền vào đúng dòng đầu tiên của chứng từ. Bằng không dời con trỏ xuống đầu dòng dưới và thêm thứ tự dòng 1 đơn vị.

If ActiveCell.Value = “” Then

ActiveCell.Value = Taikhoan

ActiveCell.Offset(ThutuDong + 1, 0).Range(“A1”).Select

ActiveCell.Value = Sotien

End If

ActiveCell.Offset(1, -SoCot).Range(“A1”).Select

ThutuDong = ThutuDong + 1

Loop

End Sub

2. Mang số tiền từ các dòng dưới cộng vào dòng đầu đối với những chứng từ có hơn một dòng phát sinh. Đối với một chứng từ chi đối ứng với nhiều tài khoản, bạn phải cộng dồn số tiền của từng tài khoản vào cột tổng cộng và trích ngang số tiền này vào các tài khoản tương ứng trên cùng một dòng.

Sub CungCTu()

Dim Ngay, Ngay2 As Date

Dim Chungtu, Chungtu2, Taikhoan, Taikhoan2, Noidung, Noidung2 As String

Dim ThutuDong, SoCot, SoDong As Integer

Dim Sotien, Sotien2 As Long

Lặp đến dòng cuối của danh sách

Range(“A2”).Select

Ngay = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Chungtu = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Noidung = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Taikhoan = ActiveCell.Value

ActiveCell.Offset(1, -3).Range(“A1”).Select

Lưu các dữ liệu cần thiết vào biến. Lặp cho đến dòng cuối của danh sách

Do Until ActiveCell.Value = “”

Ngay2 = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Chungtu2 = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Noidung2 = ActiveCell.Value

If Ngay = Ngay2 And Chungtu = Chungtu2 And Noidung = Noidung2 Then

SoDong = SoDong + 1

ActiveCell.Offset(0, -2).Range(“A1”).Select

ThutuDong = ThutuDong + 1

ActiveCell.Offset(0, 3).Range(“A1”).Select

Taikhoan2 = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Sotien2 = ActiveCell.Value

Range(“E1”).Select

SoCot = 5

Lặp đến cột tài khoản cuối cùng. Nếu tìm thấy số hiệu tài khoản thì cộng số tiền các dòng dưới lên dòng trên cùng của chứng từ, rồi thoát vòng lặp.

Do Until ActiveCell.Value = “”

If ActiveCell.Value = Taikhoan2 Then

ActiveCell.Offset(ThutuDong - SoDong + 1, 0).Range(“A1”).Select

ActiveCell.Value = Sotien2

ActiveCell.Offset(0, -SoCot + 5).Range(“A1”).Select

ActiveCell.Value = ActiveCell.Value + Sotien2

Exit Do

Else

ActiveCell.Offset(0, 1).Range(“A1”).Select

End If

SoCot = SoCot + 1

Loop

ActiveCell.Offset(1, -4).Range(“A1”).Select

Else

SoDong = 0

ActiveCell.Offset(0, -2).Range(“A1”).Select

ThutuDong = ThutuDong + 1

End If

Lưu giữ các giá trị hiện tại để tiếp tục so sánh trong vòng lặp

Ngay = Ngay2

Chungtu = Chungtu2

Noidung = Noidung2

ActiveCell.Offset(1, 0).Range(“A1”).Select

Nếu một chứng từ có nhiều dòng, phải dời con trỏ đến đúng dòng cuối.

If SoDong > 1 Then

ActiveCell.Offset(SoDong - 1, 0).Range(“A1”).Select

End If

Loop

End Sub

3. Xóa các dòng thừa (dòng thứ hai trở đi) ở những chứng từ có nhiều tài khoản đối ứng, đồng thời xóa cột TK (tài khoản).

Sub XoaDong()

Dim Ngay, Ngay2 As Date

Dim Chungtu, Chungtu2, Noidung, Noidung2 As String

Lưu giữ các giá trị ở dòng đầu để so sánh trong vòng lặp

Range(“A2”).Select

Ngay = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Chungtu = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Noidung = ActiveCell.Value

ActiveCell.Offset(1, -2).Range(“A1”).Select

So sánh lần lượt dòng trên với dòng dưới, nếu xác định là trùng nhau thì xóa các dòng thừa phía dưới.

Do Until ActiveCell.Value = “”

Ngay2 = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Chungtu2 = ActiveCell.Value

ActiveCell.Offset(0, 1).Range(“A1”).Select

Noidung2 = ActiveCell.Value

ActiveCell.Offset(0, -2).Range(“A1”).Select

If Ngay = Ngay2 And Chungtu = Chungtu2 And Noidung = Noidung2 Then

Selection.EntireRow.Delete

ActiveCell.Offset(-1, 0).Range(“A1”).Select

Else

End If

Ngay = Ngay2

Chungtu = Chungtu2

Noidung = Noidung2

ActiveCell.Offset(1, 0).Range(“A1”).Select

Loop

Xóa cột số hiệu tài khoản (TK)

Columns(“D:D”).Select

Selection.Delete Shift:=xlToLeft

Range(“A1”).Select

End Sub
 
Gửi bạn Thiên
Mình đã làm thử theo code của bạn nhưng vì không có hình 1, 2, 3 như bạn nên không biết kết quả thế nào. Bạn có thể cho mình xem mẫu hình 1, 2, 3 của bạn không.
 
hii! bạn nào đã làm rồi thì up file excel nên cho mọi người tham khảo đỡ phải mất công copy và paste....
 
ngothehoahanoi đã viết:
hii! bạn nào đã làm rồi thì up file excel nên cho mọi người tham khảo đỡ phải mất công copy và paste....
Ông bạn này lười... (giống tui quá). Bài này rất hay và đã được tác giả đăng trên tạp chí "Thế giới Vi tính" tháng 03/2005. Để các bạn tiện nghiên cứu, các bạn tải file về chạy thử nhé.

TDN
 

File đính kèm

minh ko tai duoc file cua ban,lam on huong dan minh voi
 
Hình như có sai sót... nếu dử liệu đã dc trích ngang rồi mà bấm chạy lệnh thêm nữa thì.. kết quả tầm bậy...
 
Mình có công việc cần làm trên excel,
bạn giúp mình cụ thể là:
cứ sau 01 ngày thì một cột trong sheet lại tự động hide (mỗi một cột được nhập ngày tháng theo kiểu 17-jun)
cảm ơn nhiều
progress.gif
 
Tu dong trinh ngang du lieu

Ai giúp tui với. Vid dụ mình có 1 biểu mẫu trong sheet 1 cố định rùi, khi mình đánh thông tin vào thì ở Sheet 2 có thông tin đó ở hàng thứ nhất và được xếp thành hàng ngang. Rùi đánh tiếp thông tin ở Sheet 1 thì hàng thứ 2 trong sheet 2 lại có thêm thông tin mới. Ai pjk giúp mình. Làm hoài mà không được cứ sửa thông tin ở Sheet 1 thì Sheet 2 cũng như vậy huhuhu. ai pjk liên hệ qua YH batnapquantai_honemlancuoi456@yahoo.com dùm mình nha. Thank nhiều !$@!!!$@!!!$@!!
 
Web KT

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

Back
Top Bottom