You are given the task of making a detailed table of data in the form of a chessboard like a voucher diary. Manual input for this form must use the scroll bar dragged over to retrieve the correct data column, both work and error. As you enter the necessary information, the remaining part to let Excel help, making sure the data is 100% accurate.
For example, we have a sample cash register (Figure 1) with the input convention that if a voucher has more than one matching account, it is entered on multiple lines but the date, must be the same. The task is subdivided into 3 macro routines for easy maintenance and modification of the code as needed (please skip the steps for creating, storing, and managing modules, which are quite simple. simple). Some points to note before presenting code of procedures:
To assign a cell value to a variable, move to this cell and use the value property of the current cell assigned to the variable declared (Bien = ActiveCell.Value). Finished assignments, remember to return to the old cell before moving.
Use a relative address when moving cells using the Offset (Row, Column) attribute.
- Use a fourth macro to call the three macros in turn to form a complete process, assigning shortcuts to this macro for convenient use.
1. Extract data by account generated. In this procedure, based on the account number in the TK column, the corresponding amount is spread horizontally, the money of the account is filled in the column bearing the correct account number.
Sub TrichNgang ()
Dim Taikhoan As String
Dim ThutuDong, SoCot As Integer
Dim Sotien As Long
Range ("D2"). Select
Loop to the last line of the list
Do Until ActiveCell.Value = ""
Taikhoan = ActiveCell.Value
ActiveCell.Offset (0, 1) .Range ("A1"). Select
Sotien = ActiveCell.Value
Range ("F1"). Select
SoCot = 2
Execute to the last account column. If you find an account number
Enter the amount on the top line of the document and exit the loop.
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
If the account is not found, enter the account number in the last column and enter the amount in the first line of the document. Do not move the cursor to the beginning of the bottom line and add a unit line of 1.
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. Bring the amount from the bottom line plus the first line to the vouchers that have more than one line. For a matching voucher for multiple accounts, you must multiply the amount of each account into the total column and deduct this amount from the corresponding accounts on the same line.
Subcontractor ()
Dim Right, Right2 As Date
Dim Chungtu, Chungtu2, Taikhoan, Taikhoan2, Noidung, Noidung2 As String
Dim ThutuDong, SoCot, SoDong As Integer
Dim Sotien, Sotien2 As Long
Loop to the last line of the list
Range ("A2"). Select
Right = 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
Save the necessary data into the variable. Loop to the last line of the list
Do Until ActiveCell.Value = ""
Right2 = ActiveCell.Value
ActiveCell.Offset (0, 1) .Range ("A1"). Select
Chungtu2 = ActiveCell.Value
ActiveCell.Offset (0, 1) .Range ("A1"). Select
Noidung2 = ActiveCell.Value
If Right = Right2 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
Duplicate the last account column. If you find the account number, add the following line numbers to the top line of the document, then exit the loop.
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
Store the current values to continue comparing in the loop
Right = Right2
Chungtu = Chungtu2
Noidung = Noidung2
ActiveCell.Offset (1, 0) .Range ("A1"). Select
If a document has multiple lines, move the cursor to the last line.
If SoDong & gt; 1 Then
ActiveCell.Offset (SoDong - 1, 0) .Range ("A1"). Select
End If
Loop
End Sub
Delete the extra lines (the second line onwards) in documents with multiple recipients, and delete the account (account).
Sub ()
Dim Right, Right2 As Date
Dim Chungtu, Chungtu2, Noidung, Noidung2 As String
Store the values in the first line for comparison in the loop
Range ("A2"). Select
Right = 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
Compare the top line with the bottom line, if the identifier is the same, delete the bottom line below.
Do Until ActiveCell.Value = ""
Right2 = 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 Right = Right2 And Chungtu = Chungtu2 And Noidung = Noidung2 Then
Selection.EntireRow.Delete
ActiveCell.Offset (-1, 0) .Range ("A1"). Select
Else
End If
Right = Right2
Chungtu = Chungtu2
Noidung = Noidung2
ActiveCell.Offset (1, 0) .Range ("A1"). Select
Loop
Delete column of account number (TK)
Columns ("D: D"). Select
Selection.Delete Shift: = xlToLeft
Range ("A1"). Select
End Sub
The result after running all three macros is shown in Figure 2.
Tran Xuan Thien
txthientx@fastmail.fm
Truong Giang Garment Company - Quang Nam
