Tự động trích ngang dữ liệu trong Excel

Chia sẻ: Nguyễn Phương Linh Phương | Ngày: | Loại File: PDF | Số trang:11

Thêm vào BST

Báo xấu

114
lượt xem 19
download

Download Vui lòng tải xuống để xem tài liệu đầy đủ

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.

Chủ đề:

Bình luận(0) Đăng nhập để gửi bình luận!

Lưu

Nội dung Text: Tự động trích ngang dữ liệu trong Excel

Tự động trích ngang dữ liệu trong Excel 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 Kết quả sau khi chạy cả 3 macro thể hiện ở hình 2. Trần Xuân Thiên txthientx@fastmail.fm Công ty may Trường Giang - Quảng Nam