Các cách thêm dòng mới vô 1 CSDL (cơ sở dữ liệu) đã sẵn

TQChanh

Member
Hội viên mới
BÀI I: THÊM DÒNG MỚI THEO SỐ LƯỢNG CHO TRƯỚC


Giả dụ tôi có CSDL mà trong trường [Ma] có gồm 2 nhóm dữ liệu, như sau:

PHP:
'Ma'       |. . .
102C40047 2|. . .
2114A0054 3|. . .
10240V947 8|. . .
21144G054 4|. . . 
. . .
Nhiệm vụ iêu cầu là hãy viết macro để nó thay ta thêm số dòng mới dưới mỗi dòng dữ liệu, sao cho, số dòng thêm đúng bằng chỉ số đứng riêng fía cuối của trường [Ma]

Macro đó có nội dung như sau:

PHP:
Option Explicit
Sub InsertRowsxlUp()
1 Dim Rws As Long, jJ As Long, NumFrom As Byte
 
 Rws = [A2].End(xlDown).Offset(-1).Row
3 For jJ = Rws To 2 Step -1
    With Cells(jJ, "A")
5        NumFrom = CLng(Mid(.Value, InStr(.Value, " ") + 1, 9))
        .Offset(1).Resize(NumFrom).EntireRow.Insert
7    End With
 Next jJ
End Sub
Xin lưu í: Macro đang coi trường [Ma] hiện đang ở cột 'A'
 
Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề:Điền đầy bằng các dòng trống vô 1 CSDL sẵn có số thứ tự không liên tục

BÀI II THÊM DÒNG MỚI ĐỂ CÓ TRẬT TỰ CHO TRƯỚC

Ví dụ ta có CSDL như sau:
Mã:
[B]STT  HTen    Phái   NgSinh[/b]
3   Hà My     Nam    4/1/75
5   Hà Vy     Nữ     1/4/75
' . . . . . . . . '
Giờ ta muốn thêm 2 dòng trống trên chàng Hà My & 1 dòng trên nàng Hà Vy, để trở thành như sau:

Mã:
1
2
3   Hà My     Nam    4/1/75
4
5   Hà Vy     Nữ     1/4/75
' . . . . . . . . '
(Có nghĩa là: Thêm 2 dòng cho chàng Hà My ( số 3) & 1 dòng cho nàng Hà Vy (số 5))

Chuyện như vậy sẽ nhanh chóng & không khó, một khi ta có trong tay macro như sau

Mã:
Option Explicit
[B]Sub ThemCacDongTrong()[/B]
 Dim Rng As Range, sRng As Range
 Dim Max_ As Long, jJ As Long
 
 Sheets("GPE1").Select:                         Columns("A:J").Delete
 ThisWorkbook.Worksheets("S0").[B2].CurrentRegion.Copy Destination:=[A1]
 
 Set Rng = Range([A2], [A65500].End(xlUp))
 Max_ = Application.WorksheetFunction.Max(Rng)
 For jJ = 1 To Max_
    Set sRng = Rng.Find(jJ, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        [A65500].End(xlUp).Offset(1).Value = jJ
    End If
 Next jJ
 Set Rng = [B2].CurrentRegion.Offset(1)
 Rng.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, Orientation:=xlTopToBottom
 Randomize:             [A1].Interior.ColorIndex = 34 + 9 * Rnd() \ 1
[B]End Sub[/B]
Ghi chú theo macro ta có: CSDL nguồn tại trang tính 'S0';
Kết quả mà macro đem lại tại trang tính có tên 'GPE1'
 
Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề: Xin diễn dịch các câu lệnh từ ngôn ngữ VBA sang ngôn ngữ tiếng Việt:

/-)ể hiểu rõ hơn bản chất của vấn đề, mình xin dừng 1 chút diễn dịch macro ở bài 01 sang ngôn từ tiếng Việt.
(Các dòng lệnh trong macro nói trên vừa được đánh số để tiện chúng ta theo dõi)

I./ Dịch từ ngôn ngữ VBA sang ngôn từ tiếng Việt

Dòng lệnh đầu tiên iêu cầu các biến cần dùng đều fải khai báo (& nên kh ai báo tường minh)

Dòng lệnh thứ 2: Chỉ ra tên của macro, nó là "InsertRowsxlUp" do người viết ra nó tự ấn định;
Tất nhiên ta có thể đổi lại nếu muốn, trong những trường hợp như vậy ta cũng cần có vốn liếng về lập trình VBA chút đĩnh!.

Dòng lệnh mang số 1 (gọi tắc là D1) Khai báo các biến cần sử dụng trong chương trình.
Cụ thể là 3 biến, mà trong nó có 2 mang kiểu dữ liệu Long & 1 có kiểu Byte; Thật ra chúng tất cả là dạng số, nhưng fạm vị sử dụng có khác nhau; Mà cụ thể hơn, kiểu Byte chỉ xài tới 255 mà thôi; Kiểu dữ liệu này chỉ có thể biểu thị số cột trong trang tính E2003, Nó không được xài để biểu thị số dòng (E2003) hoặc số cột (trong E>2003)

D2: Xác định dòng cuối có dữ liệu thuộc cột 'A' gán cho biến Rws đã khai báo.

D3: Tạo vòng lặp duyệt qua các dòng có dữ liệu trong cột 'A'
Vòng lặp này kết thúc ở D8
Nhưng chúng ta cần lưu í rằng vòng lặp duyệt từ dưới lên trên (từ dòng cuối chứa dữ liệu của 'A' lên đến dòng 2)
Còn tại sau fải duyệt như vậy, chúng ta sẽ đề cập sau!:cuccu:

D4: Tuyên cáo là ta làm việc với ô thuộc cột 'A' có chỉ số dòng ứng với chỉ số của biến Rws trong vòng lặp.
Kết thúc công việc này tại D8

D5 Lấy chữ số cuối của dữ liệu chứa trong ô đang khảo sát (Cells(jJ,"A").Value) đem gán vô biến NumFrom đã khai báo
Nhưng có 2 vấn đề ở đây cần lưu í:
(1) Độ dài của chữ số này có thể trên 1 chữ số, nên để xác định nó ta fải nhờ hàm InStr() trong VBA để định vị trí khoảng trống trong chuỗi. Sau đó là cắt lấy các ký tự sau vị trí đó;
(2) trước khi muốn gán vô biến NumFrom mà ta khai báo kiểu Long, nên cần fải dùng 1 hàm nữa trong VBA để chuyện từ số dạng chuỗi sang số dạng Long

D6: Thêm dưới ô đang khảo sát một số dòng, đúgn bằng số lượng chứa trong biến NumFrom

Các dòng lệnh tiếp theo ta đã đề cập bên trên, ngoài dòng lệnh cuối cùng bắt buộc macro nào cũng fải có, đó là End Sub

II./ Tại sao ta fải duyệt vòng lặp từ dưới lên:

Vì khi bạn thêm 1 dòng mới vô trang tính, thì dữ liệu của các dòng fía dưới dòng đó nếu có sẽ bị đẩy xuống 1 dòng;
Còn trong iêu cầu của bài đề ra, ta cần thêm số dòng bất kỳ nhiều ít khác nhau, tuỳ thuộc vô chỉ số đứng cuối của ô đang khảo sát;
Vậy nên giải thuật dễ là ta duyệt từ dưới lên

(/ậy câu hỏi đặt ra, là duyệt từ trên xuống, bắt đầu từ dòng 2 có được không?
Trả lời là được; Nhưng giải thuật sẽ là khó hơn như dưới đây & nói thêm: Các bạn tự nghiên cứu nhe!

III./ Cách thêm dòng từ trên xuống:

PHP:
Sub InsertRows()
 Dim nDataRow As Long, nNumOfRows As Long

 With ThisWorkbook.Sheets(1)   'Change Sheets(x) To Suit'
    nDataRow = 2  'Assumes You Have A Header Row'
    Do Until .Cells(nDataRow + 1, "A") = ""
         'Get Rows To Insert'
        nNumOfRows = Right(.Cells(nDataRow, "A"), Len(.Cells(nDataRow, "A")) - InStr(.Cells(nDataRow, "A"), " "))
        'Insert Required Rows'
        .Cells(nDataRow + 1, "A").Resize(nNumOfRows).EntireRow.Insert Shift:=xlDown
        nDataRow = nDataRow + nNumOfRows + 1    'Increment'
    Loop
 End With
End Sub
(Macro này tham khảo tại Excel Programming / VBA / Macros)

(húc các bạn thành công!
 
Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 CSDL (cơ sở dữ liệu) đã sẵn

BÀI IV THÊM 2 DÒNG CHO MỖI RECORD ĐÃ SẴN.

Trong hình dưới đây ta có dữ liệu ban đầu thể hiện ở Table A
Yêu cầu của đề bài là cứ mỗi dòng dữ liệu thêm 2 dòng;
Hơn nữa, trên các dòng thêm cần nhập sẵn dữ liệu lần lượt là chuỗi 'A' hay 'B' & các chuỗi này được canh fải trong cột [Ten]
(Như Table B trong hình)



Toàn bộ iêu cầu này sẽ được macro sau đây thực hiện nghiêm chỉnh

PHP:
Option Explicit
Sub ProgrammingAdd2Rows()
 Dim Cls As Range
 Dim Rws As Long:                           Dim MyStr As String
 
 Sheets("Sheet2").Select
 Columns("A:A").Select:                     Selection.Insert Shift:=xlToRight
 Rws = Cells(Rows.Count, "C").End(xlUp).Row
 Cells(Rws, "A").Value = "GPE.COM":         Cells(1, "A").Value = "GPE.COM"
 
 For Each Cls In Range("C2:C" & Rws)
    MyStr = "A" & Cls.Row:                  Cls.Offset(, -2).Value = MyStr
    With Cells(Rows.Count, "A").End(xlUp).Offset(1)
        .Value = MyStr & "A":               .Offset(, 2).Value = "A"
        .Offset(1).Value = MyStr & "B":     .Offset(1, 2).Value = "B"
        .Offset(, 2).Resize(2).HorizontalAlignment = xlRight
    End With
 Next Cls
 [A1].CurrentRegion.Select
 Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1
 Columns("A:A").Delete
End Sub
Nếu nghiên cứu kỹ các giải fáp trong mỗi macro, các bạn sẽ thấy thích thú vì sự khác biệt giứa chúng

Ở macro bài đầu & bài 3 là ta thêm dòng đúng như í đồ nhiệm vụ iêu cầu (Là thêm dòng; tuy cách thêm của mỗi macro mỗi khác)

Còn macro ở bài 2, chúng ta thấy nó thực tế ra không có lệnh thêm dòng nào cả;
Mà nó chỉ thêm số liệu thích ứng vô các dòng trống; Rồi sau rốt, nó đi xếp lại theo trật tự của cột là được theo iêu cầu đã đề ra.

Còn macro ở bài này các bạn thử nghiên cứu trước xem sao?!

Thân ái & chúc thành công!
 
Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề: Thêm 1 cách thức thêm dòng nữa cho bài 1

BÀI V MỘT CÁCH THÊM DÒNG KHÁC:

KHÔNG FẢI THÊM DÒNG MÀ Y NHƯ THÊM DÒNG
:xinchao:
2ua các bài I, II & IV ta đã liệt kê 2 biện fáp thêm dòng cho 1 CSDL (bài I & II);
Mà trong đó cách đơn giản nhất (trong 2 cách) là thêm dòng từ dưới đáy CSDL lên trên.
Còn cách thêm từ trên thì thuật toán chỉ giành cho những người "cao siêu" về trí tuệ;

Bài này xin giới thiệu với các bạn cách thứ 3 dung hòa giữa 2 cách trên

Xin fép các bạn mô tả lại CSDL ở #1, nhưng có thêm chỉ số dòng tương ứng của các records
Mã:
[COLOR="silver"]1[/COLOR]|[B][COLOR="red"]Ma[/COLOR][/B]         |. . .
[COLOR="silver"]2[/COLOR]|102C40047 2|. . .
[COLOR="silver"]3[/COLOR]|2114A0054 3|. . .
[COLOR="silver"]4[/COLOR]|10240V947 8|. . .
[COLOR="silver"]5[/COLOR]|21144G054 4|. . .  
[COLOR="silver"]6[/COLOR]|. . . .
Các bước giải thuật của fương án này sẽ là:

(1) Thêm cột vô ng ay trước cột 'A' hiện đang là trường [Ma]
(1.1) Tiếp sau đó, ta ghi chuỗi gì vô [A1] & ô trên cột 'A' ứng với dòng cuối chứa dữ liệu của trường [Ma] (bây chừ là thuộc cột 'B')

Mã:
 |   [COLOR="silver"]A[/COLOR]   |  [COLOR="silver"] B[/COLOR]       | [COLOR="silver"]C[/COLOR]
[COLOR="silver"]1[/COLOR]|GPE.COM|[B][COLOR="red"]Ma[/COLOR][/B]         |. . .
[COLOR="silver"]2[/COLOR]|       |102C40047 2|. . .
[COLOR="silver"]3[/COLOR]|       |2114A0054 3|. . .
[COLOR="silver"]4[/COLOR]|       |10240V947 8|. . .
[COLOR="silver"]5[/COLOR]|GPE.COM|21144G054 4|. . .  
[COLOR="silver"]6[/COLOR]|       |. . . .
(2) Ta lập 1 macro để duyệt từ dòng 2 đến dòng cuối có dữ liệu của cột 'B'
Trong quá trình duyệt qua mỗi dòng record ta tiến hành 2 động tác sau:
(2.1) Tại cột 'A' dòng đang duyệt ta sẽ ghi chuỗi gồm kí tự 'A' & chỉ số dòng của nó;
(2.2) Tại ô ngay dưới ô cuối có dữ liệu của cột 'A' ta ghi chuỗi cũng gồm kí tự 'A' cùgn với chỉ số dòng như trên, nhưng thêm sau nó cái số mà đề bài iêu cầu ta thêm dòng.
Cụ thể để các bạn dễ hình dung: Nếu ta đang khảo sát dòng thứ 2 (đứng tại dòng 2 của CSDL)
Thì ta thêm chuỗi 'A2' tại ô [A2]
& tại [A6] ta nhập chuỗi 'A22'
Trong đó chỉ số 2 đầu chỉ ra dòng đang khảo sát, số 2 sau là số dòng cần thêm;
(2.3) Chép dữ liệu của ô cuối cùng cột 'A' này xuống ngay các ô dưới nó; Sao cho tổng các ô chứa cùng dữ liệu này đúng bằng số dògn cần chép (trường hợp đang khảo sát dòng 2, ta cần chỉ chép thêm 1 dòng nữa =>2)

Ví dụ sau khi khảo sát xong dòng 3 ta có hình ảnh sau:

Mã:
  |  [COLOR="silver"]A[/COLOR]    |  [COLOR="silver"] B[/COLOR]       | [COLOR="silver"]C[/COLOR]
[COLOR="silver"]1[/COLOR] |GPE.COM|[B][COLOR="red"]Ma[/COLOR][/B]         |. . .
[COLOR="silver"]2[/COLOR] | A2    |102C40047 2|. . .
[COLOR="silver"]3[/COLOR] | A3    |2114A0054 3|. . .
[COLOR="silver"]4[/COLOR] |       |10240V947 8|. . .
[COLOR="silver"]5[/COLOR] |GPE.COM|21144G054 4|. . .  
[COLOR="silver"]6[/COLOR] |  A‚22  |           |. . . . 
[COLOR="silver"]7[/COLOR] |  A‚22  |           |. . . . 
[COLOR="silver"]8[/COLOR] |  A‚33  |           | . . . . 
[COLOR="silver"]9[/COLOR] |  A‚33  |           |  . . . . 
[COLOR="silver"]10[/COLOR]|  A33  |           |. . . .
Có thể có bạn thắc mắc:

(*) Là làm sao ta có thể chép; Thực ra nếu ta biết fương thức Resize(m,n) trong VBA thì chuyện này như trở bàn t ay thôi!

(*) Vậy chuỗi 'GPE.COM ta thêm dòng cuối cột 'A' ban đầu làm chi vậy?
Nó dùng làm mốc tạm thời để ta biết nơi cần chép khi khảo sát dòng đầu tiên
& ta khỏi lăn tăng vì sự tồn tại của nó chỉ trước khi ta khảo sát dòng của chính nó mà thôi.

(3) Tiến hành chọn toàn bộ CSDL & vô menu Data để xếp theo trật tự của cột 'A'

(4) Bước cuối là xóa cột 'A' này dđể trang tính ta về nguyên trạng theo thứ tự cột như ban đầu.


/-)ó là mình đã trình bày xong cách suy nghĩ để có được 1 giải thuật.

Một khi ta đã có bước đi, thì chuyện viết thành những dòng lệnh cụ thể sẽ đơn giản như đang zỡn zậy thôi.

Rất mong bạn nào có thể hiện thực hóa tiếp í tưởng này & chúc thành công!
 
Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề:Cách nào thêm dòng "Cộng số phát sinh" và số dư khi kết thúc cuối mỗi tháng

BÀI VI: THÊM DÒNG FÁT SINH SAU MỖI THÁNG GIAO DỊCH.


Các bài trước đây ta thấy có vẻ xa thực tế; Hôm nay ta giải quyết bài toán sát sườn hơn; Đó là thêm 2 dòng "Cộng số phát sinh" & "số dư " khi kết thúc cuối mỗi tháng giao dịch. Xin mời các bạn xem hình dưới đây:
[/IMG]

Vì là giao dịch theo í khách hàng, cho nên không fải lúc nào cuối tháng cũng có giao dịch, cũng như ngày cuối tháng có thể có nhiều hơn 1 giao dịch.

Bỡi vậy việc tìm cho được dòng giao dịch cuối cùng của 1 tháng là không đơn giản!

Fương án của chúng ta sẽ là:

Dùng AdvancedFilter (bằng VBA) lọc riêng giao dịch từng tháng;

Sau đó ta tìm ngày cuối giao dịch của tháng; Chỉ khi đó ta sẽ tìm ra lần giao gdịch cuối cùng trong tháng.

Cũng chỉ khi ta đã lọc giao dịch từng tháng ta mới biết tổng số tiền fát sinh trong tháng (gởi vô hay rút ra). & khi đó ta mới có số liệu để mà ghi vô 2 dòng này theo iêu cầu đề ra của đầu bài.

(Xem trong hình: dòng 94 & 95 cũng như 203 & 204)

Sau đây mình đưa lên toàn bộ nội dung macro để các bạn tiện trong việc xem trước;

Sau đó mjình sẽ giải thích thêm các câu lệnh trong macro này:

PHP:
Option Explicit
Sub AddVancedFilter()
 Dim Rng As Range, sRng As Range, WF As Object, Rg0 As Range, tRg As Range
 Dim MyAdd As String, Format_ As String, SFS As String, SDu As String
 Dim Rws As Long, Th0 As Double, ThM As Double, jj As Byte, Dat As Double
 Dim Goi As Double, Rut As Double, SoDu As Double
    
 Sheets("112NN").Select
 SFS = [AD1].Value:                         SDu = [ad2].Value
 Set WF = Application.WorksheetFunction
 Set Rng = [B10].CurrentRegion:             Rws = Rng.Rows.Count
 Set Rng = [A10].Resize(Rws, Rng.Columns.Count)
 Set Rg0 = Rng(1).Offset(1).Resize(Rws):    Format_ = Rg0.NumberFormat
 Rg0.NumberFormat = "mm/dd/yyyy"
 Th0 = WF.Min(Rng(1).Resize(Rws)):          ThM = WF.Max(Rng(1).Resize(Rws))
 SoDu = [H8].Value
 For jj = Month(Th0) To Month(ThM)
    [aa5].Value = DateSerial(Year(Th0), jj, 1)
    [aB5].Value = DateSerial(Year(Th0), jj + 1, 1)
    Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
        ("AA1:AB2"), CopyToRange:=Range("AA10:AH10"), Unique:=False
    Dat = WF.Max([AA10].Resize(Rws))
    Goi = WF.Sum([Af10].Resize(Rws)):       Rut = WF.Sum([Ag10].Resize(Rws))
    
    Set sRng = Rg0.Find(Format(Dat, "mm/dd/yyyy"), , xlValues, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Set tRg = sRng
            Set sRng = Rg0.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        tRg.Offset(1).Resize(2).EntireRow.Insert
        With tRg.Offset(1, 3) ' *2'
            .Value = SFS & Right("0" & CStr(jj), 2)
            .Offset(, 2).Value = Goi:       .Offset(, 3).Value = Rut
            .Offset(1).Value = SDu & Right("0" & CStr(jj), 2)
            SoDu = SoDu + Goi - Rut:        .Offset(1, 4).Value = SoDu
        End With
    Else
        MsgBox "Nothing", , jj
    End If
 Next jj
End Sub
Bổ sung đường dẫn của file đính kèm: Th�m d�ng "C?ng s? ph�t sinh " m?i th�ng
(Trong file có 2 macro, các bạn chỉ nên quan tâm macro đang có ở module thôi!
 
Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề:Cách nào thêm dòng "Cộng số phát sinh" và số dư khi kết thúc cuối mỗi tháng (tiếp)

Bài này ta lần theo các bước tìm lần (hàng, record) giao dịch cuối của mỗi tháng

Muốn vậy điều trước tiên ta cần tìm là trong CSDL này ngày nào là ngày giao dịch đầu tiên & đâu là ngày cuối cùng của giao dịch?

(1) Tìm ngày giao dịch đầu tiên & sau cùng của CSDL

Muốn vậy, ta cần nhờ hàm MIN() & hàm MAX() của bảng tính excel tìm trị nhỏ nhất của cột 'A', là cột chứa dữ liệu ngày tháng các giao dịch.
Hai trị tìm được này, theo macro, ta đã đem gán vô 2 biến Th0 & ThM
Cũng từ 2 trị này mà ta biết được số tháng có giao dịch trong CSDL

(2) Dùng fương thức AdvancedFilter lọc các giao dịch của từng tháng.

Để lọc ta cần dọn sẵn nơi chứa điều kiện lọc & nơi để kết quả lọc hiễn thị;

Trong trang tính '112NN' mà các bạn thấy trong file đính kèm, vùng [AA1:AB2] là vùng Đ/K lọc & vùng [AA10:AH10] chính là vùng chứa kết quả lọc.

Thực thi điều này, ta nhờ đến vòng lặp FOR . . . NEXT duyệt hết qua các tháng, bắt đầu từ tháng chứa ngày 'Th0' & tháng cuối trong 'ThM'

Cứ trong mỗi lần lặp, ta cung cấp cho 2 ô Đ/K lọc những trị tương ứng của tháng & nhận được kết quả tương tháng đó tại vùng hiễn thị kết quả. (Từ giờ trở đi ta gọi vùng này là vùng tháng)
(Chúng ta không nhất thiết fải quan tâm đến ngày giao dịch đầu của tháng). Ngày giao dịch cuối của tháng ta tìm thấy trong vùng tháng (cũng nhờ hàm MAX() trong cột đầu của vùng này)

Sau khi tìm ra ngày giao dịch cuối của tháng vẫn chưa hết chông gai; Bỡi lẽ trong ngày này có thể có trên 1 giao dịch!

Để tìm ra dòng giao dịch cuốc cùng ta có thể có 2 cách đơn giản:

(3) Tìm ra dòng giao dịch cuối cùng trong mỗi tháng

(*) Vòng lặp For. . .Next hay Do. . . . Loop
(*) dùng fương thức tìm kiếm (FIND methode) như macro đang dùng.

(Bài tổng quan về fương thức này bằng tiếng Việt không đâu tốt bằng T?ng h?p v? ph??ng th?c t�m ki?m FIND ( Find Method)))

Việc tìm ra dòng giao dịch cuối mỗi tháng ta fải thực hiện ngay trên CSDL, chứ ta không thể thực hiện trên vùng tháng được. Vì 1 lẽ đơn giản là sau khi tìm ra dòng này, ta cần thực hiện bước tiếp theo là lấy dòng dưới liền kề dòng này & thêm 2 dòng trống

. . . .
 

TQChanh

Member
Hội viên mới
Ðề: Cách nào thêm dòng "Cộng số phát sinh" và số dư khi kết thúc của mỗi tháng (fần cuối)

/(/hiệm vụ của chúng ta sau khi thêm 2 dòng vào sau mỗi tháng giao dịch, là ta fải thêm dữ liệu mới vô chúng; Mà cụ thể công việc của chúng ta fải là:

(1) Thêm định danh của các dòng này
(Các định danh này ta thêm vào cột 'D' của các dòng mới)
Dòng đầu ta cần thêm chuỗi, như "Cộng fát sinh tháng 01"
Nhận xét: Chuỗi này bao gồm 2 cấu tử, cấu tử đầu là chuỗi thật sự, cấu tử sau là con số chỉ tháng giao dịch;

(/ề các con số này thì quá dễ, vì ta sẽ lấy ra từ vòng lặp trích lọc dữ liệu lần lượt của từng tháng
;
(/ề chuỗi ta sẽ có fiền 1 xíu, do VBA không được UNICode hỗ trợ, nên cách làm trong macro là:

Lấy đoạn văn bản này trong 1 ô sẵn ghi trên bản tính; Đó là ô [AD1] trên '112NN' & ghi lên dòng vừa thêm mới
(Chuỗi trong dòng thứ 2 cũng cách làm tương tự)

Như vậy ta xong fần định danh của dòng; Tiếp theo sẽ là các số liệu tổng hợp từng tháng theo iêu cầu

(2) Thêm số liệu fát sinh của tháng tương ứng

(2.1) Số liệu fát sinh gồm có số gởi vào & số lượng tiền rút ra;
Các số liệu này không mấy khó tìm ra, một khi ta đã dùng fương thức AdvancedFilter để lọc ra từng tháng; (Kết quả lọc các tháng luôn thể hiện tại vùng dữ liệu bao bỡi các cột [AA:AH] bắt đầu từ dòng 10 trở đi (trang tính đã nêu)
Một khi ta có số liệu của lần lượt từng tháng, thì việc lấy số liệu của tháng là chuyện trở bàn tay (& xin fép tôi lướt qua fần này).

(2.2) Tìm số dư cuối mỗi tháng

Để giải chuyện này, ta fải bắt đầu từ ô [H8], nơi đang ghi số dư đầu kì
Ta cần sao lưu số này vô biến (trong macro có tên khai báo là 'SoDu'

/(/hư vậy, sau mỗi lần ta tìm & ghi số fát sinh trong tháng thì ta chỉ việc tìm số dư sau tháng đó;
Số dư này từ fép toán cộng đại số sau đây:

SoDu (Tháng này) = SoDu (Kì trước) + Số gởi vô - Số rút ra

SoDu này sẽ được chúng ta ghi xuống cột 'H' của dòng thứ 2 mới thêm & nó vẫn trong bộ nhớ cho lần tính kế tiếp (Lúc đó nó lại trở thành SoDu (kì trước) trong biểu thức trên

/(/hư vậy là chúng ta kết thúc con đường chông gai rồi đó, các bạn à!

(húc các bạn nhiều thành công.

:dotphao:
 

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 CSDL (cơ sở dữ liệu) đã sẵn



BÀI VII THÊM MỘT DÒNG SAU MỖI DỰ ÁN.
:xinchao:

Giả dụ mình có CSDL liệt kê các project như dưới đây:

PHP:
 1|Pro-0001
 2|Pro-0001
 3|Pro-0001
 4|Pro-0001
 5|Pro-0001
 6|Pro-0002
 7|Pro-0002
 8|Pro-0002
 9|Pro-0003
 10|Pro-000A
 11|Pro-000A
 12|Pro-000A
 13|Pro-0005
 14|Pro-0005
 15|Pro-0005
 16|Pro-000F
 17|Pro-000F
Giờ, nhiệm vụ đề ra cho mình là thêm 1 dòng mới sau mỗi project để được như sau:

Mã:
  1|Pro-0001
  2|Pro-0001
  3|Pro-0001
  4|Pro-0001
  5|Pro-0001
   |
  6|Pro-0002
  7|Pro-0002
  8|Pro-0002
   |
  9|Pro-0003
   |
 10|Pro-000A
 11|Pro-000A
 12|Pro-000A
   |
 13|Pro-0005
 14|Pro-0005
 15|Pro-0005
   |
 16|Pro-000F
 17|Pro-000F
[COLOR="white"]. .[/COLOR]|[COLOR="white"]. . . [/COLOR]

/(/hiệm vụ này dễ thực thi, nếu ta có macro nội dung sau:

PHP:
Sub InsertRowForProject()
 Timer_ = Timer
 Range("B1").Select
 ActiveCell.Offset(1, 0).Select
 While ActiveCell.Value <> ""
    If ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value Then
        ActiveCell.EntireRow.Insert
        ActiveCell.Offset(2, 0).Select
    Else
        ActiveCell.Offset(1, 0).Select
    End If
 Wend
 [F65500].End(xlUp).Offset(1).Value = Timer - Timer_
End Sub
Theo như nội dung macro, các Project của chúng ta đang được liệt kê tại cột 'B'
Cái tinh tế trong macro này là người ta (Excel Programming / VBA / Macros) sử dụng vòng lặp Do . . . Loop với bước nhảy tùy muốn.

:khakha:
 

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 CSDL đã sẵn (Bài VIIA)

:dotphao:
BÀI VIIA THÊM DÒNG SAU MỖI NHÓM DỮ LIỆU GIỐNG NHAU CỦA 1 TRƯỜNG
:xinchao:

Thực ra dữ liệu vẫn như bài VII bên trên (chỉ là đổi cách gọi ngỏ hầu đỡ nhàm chán & . . . )
(/ấn đề trọng tâm của bài này là tốc độ (thời gian) thực hiện hoàn chỉnh macro một cách nhanh nhứt.

Ta giả dụ ở #7 (bài VII) ta có hơn trăm dự án (cỡ 1.000 dòng records), macro sẽ fải chạy trong vòng 2 giây; Đó là macro chỉ chạy trên 1 cột đơn (cột 'B') mà thôi; Thời gian sẽ kéo dài thêm nếu trong thực tế có thêm các trường khác sau nó như
[Journal], [Puchaser Decs.], [Units], [Qty.], [Cost],. . . . , [Project Total] . . . . đi kèm & điều này là tất iếu trong 1 CSDL.
Thời gian lúc đó sẽ tăng thêm đán kể.

/-)ể giảm thời gian "chạy tàu" đi cỡ 5 lần, mình xin giới thiệu 1 macro dùng mảng để tăng tốc cho nó.

(/ấn đề ở đây không fải là tiết kiệm thời gian, điện năng & nhiều thứ khác. . . ; mà chủ iếu là giới thiệu với các bạn 1 thuật toán rất đán quan tâm một khi ta fải làm việc với 1 CSDL đồ sộ (cỡ vạn dòng)

Macro có nội dung như sau:
:deny2:
PHP:
Option Explicit
Dim Timer_ As Double
Sub InsertBlankRowsForArr()
 Dim Rws As Long, wW As Long, zZ As Long, fF As Long
 
 Timer_ = Timer
 Rws = Cells(Cells.Rows.Count, "B").End(xlUp).Row
 ReDim Arr(1 To 2 * Rws)
 
 ReDim ATmp(1 To Rws + 1)
 ATmp() = Range("B1:B" & Rws + 1)
 
 zZ = Rws + 1:                          Arr(zZ) = "A0"
 For wW = 1 To Rws
    Arr(wW) = "A" & fF
    If ATmp(wW + 1, 1) <> ATmp(wW, 1) Then
        zZ = zZ + 1:                    fF = fF + 1
        Arr(zZ) = "A" & fF & zZ
    End If
 Next wW
 Range("A1:A" & 2 * Rws).Value = WorksheetFunction.Transpose(Arr)
 
 Columns("A:B").Select
 Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False
 Columns("A:A").Select
 Selection.ClearContents
 [H65500].End(xlUp).Offset(1).Value = Timer - Timer_
End Sub
:k5211829:
 

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 CSDL đã sẵn (Bài VIIB)

BÀI VIIB: VỪA THÊM DÒNG VỪA THÊM DÒNG TỔNG LƯỢNG TRONG PROJECT


Trong hình dưới đây mô tả CSDL về các project trong 1 kỳ của 1 cơ quan

[/IMG]

Phần fía trên là CSDL nguyên thủy; Còn fần bên dưới là kết quả sau khi đã chạy macro

Nội dung macro như dưới đây:
PHP:
Sub InsertBlanlRowWithToTal()
 Dim Rws As Long, wW As Long, ToTal As Double, zZ As Long
 Dim Cls As Range
 
 Columns("H:H").Insert Shift:=xlToRight
 Rws = Cells(Cells.Rows.Count, "B").End(xlUp).Row
 
 ReDim Arr(1 To 2 * Rws, 1 To 2):               ReDim ATmp(2 To Rws + 1)
 
 ATmp() = Range("B2:B" & Rws + 1).Value:
 Arr(1, 1) = "Project ToTal":                   Arr(1, 2) = "GPE.COM"
 Arr(Rws + 1, 2) = "A01"
 For wW = 2 To Rws
    Arr(wW, 2) = "A" & zZ
    ToTal = ToTal + Cells(wW, "F").Value
    If ATmp(wW - 1, 1) <> ATmp(wW, 1) And ATmp(wW, 1) <> "" Then
        zZ = zZ + 1
        Arr(1 + Rws + zZ, 2) = "A" & zZ & zZ:   Arr(wW, 1) = ToTal
        ToTal = 0
    End If
GPE:
 Next wW
 [h1].Resize(2 * Rws, 2).Value = Arr()
 [h1].CurrentRegion.Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 Columns("I:I").ClearContents
End Sub
 

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 cơ sở dữ liệu đã sẵn

BÀI THAM KHẢO: THÊM SỐ DÒNG TÙY THUỘC VÔ TRỊ GIỮA 2 DÒNG.
:xinchao:

(Bài này chỉ mang tính giải thuật, vì liên quan đến "Kỹ thuật" là chủ iếu)

Iêu cầu của đề bài là:
Em có các bảng số liệu đo gồm 3 cột là: [A] là số TT, là khoảng cách & [C] là cột độ cao . em muốn chèn thêm vào bảng số liệu đo này những dòng cách khoảng (là gia trị dòng dưới trừ dòng trên liền kề nó ) >20m thì chèn thêm 1 dòng và giá trị bằng giá trị dòng trước nó + thêm số ngẫu nhiên <20,còn cột [C] thì tính tương ứng theo tỉ lệ giá trị chèn vào. Chèn dòng sao cho giá trị dòng trên trừ dưới luôn < 20. Các bác viết VBA giúp em với nhé,




Nội dung macro đó như sau:

PHP:
Option Explicit
Sub AddRow20()
 Dim jJ As Long, eRw As Long, SoNgau As Double, MColor As Byte, DG As Double
 Dim B1 As Range, C1 As Range, GPE As Boolean

 eRw = 2 * [B65500].End(xlUp).Row    '<=| Tang Doi Só Dòng Càn Xu Lí'
 With [A1].Interior
   If .ColorIndex < 34 Or .ColorIndex > 42 Then
      MColor = 35
   Else
      MColor = .ColorIndex + 1
   End If
   .ColorIndex = MColor
 End With
 For jJ = 3 To eRw
   If Cells(jJ, "B").Value > Cells(jJ - 1, "B").Value + 20 Then
      GPE = True
      Cells(jJ, "B").EntireRow.Insert
      DG = Cells(jJ + 1, "B") - Cells(jJ - 1, "B") - 15
      Randomize:                    SoNgau = 7 + 9 * Rnd()
      
      Cells(jJ, "B").Value = SoNgau + Cells(jJ - 1, "B").Value
      Set B1 = Cells(jJ - 1, "B"):                 Set C1 = B1.Offset(, 1)
      Cells(jJ, "c").Value = C1 + ((C1.Offset(2) - C1) * (B1.Offset(1) - B1)) / (B1.Offset(2) - B1)
      Cells(jJ, "B").Interior.ColorIndex = MColor
      jJ = jJ + 1
   Else
   End If
   Cells(jJ, "A").Value = 1 + Cells(jJ - 1, "A")
 Next jJ
 If GPE Then
   GPE = False:                              AddRow20
 Else
   Cells([B65500].End(xlUp).Row + 1, "A").Resize(eRw).ClearContents
   Exit Sub
 End If
 Set C1 = [d1]:                              jJ = 0
 GPE = False:                                eRw = 0
 SoNgau = CInt(Right([A1], 1))
 For Each B1 In Range([B2], [B65500].End(xlUp))
   eRw = 1 + eRw
   If B1.Interior.ColorIndex > 9 Then jJ = jJ + 1
   If GPE = True Then B1.Offset(, -1).Value = eRw
   If B1.Value = "" Then
      C1.Value = "Add " & jJ & " rows":      GPE = True
      Set C1 = B1.Offset(, 2):               jJ = 0
      SoNgau = SoNgau + 1:                   eRw = 0
      B1.Offset(, -1).Value = "Bang" & Str(SoNgau)
   End If
 Next B1
 C1.Value = "Add " & jJ & " rows"
End Sub

/(ết quả do macro đem lại sẽ là như hình dưới đây:



 
Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 CSDL đã sẵn (Bài VIIC)

BÀI VIIC Add values after sort.

(/ấn đề là tôi có trang dữ liệu như dưới đây:
PHP:
         A  B
         1  100
         1   20
         2  100
         2   30
         3  100
         3  10
Giờ tôi có macro để chuyển dữ liệu sau khi đã sắp xếp như trên thành như sau:

Mã:
[COLOR="silver"]A     B[/COLOR]
1    100
1     20
    [B] 120 [/B]
(empty row)
2    100
2    30
  [B]   130[/B]
(empty row)
3    100 
3    10
  [B]   110[/B]

Macro sau đây sẽ làm nhiệm vụ đề ra được toại nguyện:

PHP:
Option Explicit
Sub Insert2BlanlRowWithToTal()
 Dim Rws As Long, jJ As Long, Zz As Long
 Dim Total As Double
 
 Columns("C:c").Insert Shift:=xlToRight
 Rws = Cells(Cells.Rows.Count, "B").End(xlUp).Row
 ReDim Arr(1 To 2 * Rws, 1 To 2)
 For jJ = 1 To Rws
    Arr(jJ, 1) = Cells(jJ, "B").Value
    Arr(jJ, 2) = "A" & jJ:
    Total = Total + Cells(jJ, "B").Value
    If Cells(jJ + 1, "A").Value <> Cells(jJ, "A").Value Then
        Zz = Zz + 2
        Arr(Rws + Zz - 1, 1) = Total:         Total = 0
        Arr(Rws + Zz - 1, 2) = "A" & jJ & jJ
        Arr(Rws + Zz, 2) = "A" & jJ & jJ & jJ
    End If
 Next jJ
 [B1].Resize(2 * Rws, 2).Value = Arr()
 [B1].CurrentRegion.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False
 Columns("C:C").Delete Shift:=xlToLeft
End Sub
:sorrynha:
 

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 CSDL đã sẵn (Bài VIID)

:dotphao:

BÀI VIID Find word then insert 2 rows

I've found similar results for code online but not exactly what I want and I don't know how to modify it to do what I want.

Basically I want to search for the word "Total", once found insert 2 entire rows underneath that "Total". Then continue to search for all "Total" strings and continue adding 2 rows until no more are found.

Can anybody help me out with this?

(Note: The word "Total" actually comes after several categories ie. ABCA Total, ABCB Total)
This macro has superior speed

PHP:
Option Explicit
Sub Add2RowsWithMethodeFIND()
 Dim lRow As Long, MyAdd As String
 Dim Rng As Range, sRng As Range
 
 lRow = Cells(Rows.Count, "A").End(xlUp).Row
 Set Rng = [c1].Resize(2 * lRow)
 Set sRng = Rng.Find("Total", , xlFormulas, xlPart)
 If Not sRng Is Nothing Then
    MyAdd = sRng.Address
    Do
        sRng.Offset(1).Resize(2).EntireRow.Select
        Selection.Insert
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
End Sub
:mocmui:
 

TQChanh

Member
Hội viên mới
Ðề: Bản dịch #4

BẢN DỊCH CÂU LỆNH TẠI BÀI IV

Dưới đây là nội dung macro tại bài IV mà chúng ta đã xem xét:
(Mình đã them số cho các dòng lệnh để tiện việc diễn dịch & theo dõi)

PHP:
Option Explicit 
Sub ProgrammingAdd2Rows() 
 Dim Cls As Range 
 Dim Rws As Long:                           Dim MyStr As String 
  
1 Sheets("Sheet2").Select 
 Columns("A:A").Select:                     Selection.Insert Shift:=xlToRight 
3 Rws = Cells(Rows.Count, "C").End(xlUp).Row 
 Cells(Rws, "A").Value = "GPE.COM":         Cells(1, "A").Value = "GPE.COM" 
  
5 For Each Cls In Range("C2:C" & Rws) 
    MyStr = "A" & Cls.Row:                  Cls.Offset(, -2).Value = MyStr 
7    With Cells(Rows.Count, "A").End(xlUp).Offset(1) 
        .Value = MyStr & "A":               .Offset(, 2).Value = "A" 
9        .Offset(1).Value = MyStr & "B":     .Offset(1, 2).Value = "B" 
        .Offset(, 2).Resize(2).HorizontalAlignment = xlRight 
    End With 
11 Next Cls 
 [A1].CurrentRegion.Select 
13 Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1 
 Columns("A:A").Delete 
End Sub
Hài dòng trước D1 (dòng lệnh mang số 1) là 3 câu lệnh khai báo các biến cần dùng;

D1: Kích hoạt rrang tính đang có trên là “Sheet2”

D2: Fần đầu của dòng lệnh: Ta chọn (kích hoạt) cột ‘A:A” của trang tính;

Câu lệnh fần sau: Thêm 1 cột vô trước cột “A:A” vừa chọn

Khi đó cột ‘A:A” trước trở thành cột ‘B’,. . .

Vấn đề ở đây là tại sao ta thêm mới cột ‘A:A”. Khi đó thì CSDL (cơ sở dữ liệu) của chúng ta không bị sáo trộn nhiều. hay thay đổi cấu trúc về sau.

D3: Xác định ô cuối của cột ‘C:C” có dữ liệu, đem số dòng của ô này gán vô biến đã khai báo.

D4.1 Gán trị nào đó (ở trong macro là GPE.COM”) cho ô cuối của cột ‘A:A”
D4.2: Cũng gán trị này vô ô đầu tiên của trang tính hiện hành.
Có thể bạn có câu hỏi: Để làm chi vậy?
Trả lời: D4.1: Định vị ô cuối tương ứng với dòng cuối có dữ liệu của các cột CSDL thuôc cột ‘A:A”
D4.2 Dùng làm tiêu đề cột ([A]) để sau này ta áp dụng fương thức sắp xếp theo cột [A] này (D13)

D5: Tạo vòng lặp duyệt tất thẩy các ô có dữ liệu tại cột [C]
Vòng lặp này kết thúc tại câu lệnh D11

D6.1: Tại ra chuỗi bỡi kí tự ‘A” nối với chỉ số dòng của ô đang khảo sát đem gán vô biến MyStr

D6.2: Đem trị trong biến này gán lên ô cùng dòng thuộc cột [A]

D7: Công bố với bàn dân thiên hạ là ta sẽ làm việc với ô liền kề ngay bên dưới ô cuối có dữ liệu của cột [A]
(Khi bắt đầu vòng lặp thì ô cuối này có trị là “GPE.COM” do D4.1 đem lại)

D8.1: Đem trị trong biến MyStr nối thêm kí tự “A’ gán vô ô này;

D8.2: Cách ô vừa gán 2 cột về bên f ải ta gàn chỉ ký tự ‘A”

2 câu lệnh trong dòng D9 cũng tương tự, chỉ có khác mỗi chổ: Thay vì nơi nào là ‘A’ ờ trên, giờ là ‘B”

Để hiểu rõ hơn, ta xem trích trang tính như dưới đây ngay sau khi khảo sát ô đầu tiên của vòng lặp ([C2])

Mã:
[B]GPE.COM[/B] | [B]Ma[/B]  |   [B]Ten   [/B]    | [B]NgaySinh[/B]
A2      |JS000|Jonh Smith   | 7/1/1947
        |JW000|Jane W.      | 7/2/1947
 GPE.COM|EB000|Eva Bobbyton | 7/1/1947
 A2A    |     |           A | 
A2B     |     |            B|
Việc gì sẽ diễn ra khi ta chạy hết vòng lặp:

Lúc đó dưới A2 sẽ là A3 & GPE.COM dưới A3 sẽ là A4
& dưới A2B Sẽ là A3A-> A3B->A4A->A4B (theo cột [A])

Đến đây các bạn sẽ mường tượng ra vấn đề, một khi ta xếp CSDL theo cột [A] tăng dần; Việc này được tiến hành tại câu lệnh 13

Lúc đó sẽ là GPE.COM -> A2-> A2A-> A2B-> A3 ->A3A -> A3B -> A4 ->A4A-> A4B

Cuối cùng, macro sẽ xoá cột [A] do nó tạo ra từ ban đầu.

(Để xem kết quả của macro trước khi nó tiến hành sắp xếp, ta có thể vô hiệu hóa 2 d o02ng lệnh gần cuối của nó 1 cách tạm thới!)
 

TQChanh

Member
Hội viên mới
Ðề: Cách thêm dòng mới vô CSDL & thêm công thức vô 1 số ô trong dòng vừa thêm

BÀI VIII LẬP CÔNG THỨC TÍNH TẠI 1 SỐ Ô TRONG DÒNG VỪA THÊM

Các bạn mường tượng nhiệm vụ đề ra như sau:

(*) Chúng ta thu thập được các số liệu khoa học từ cuộc thí nghiệm dài hơi (Fần 'A" trong hình bên dưới đính kèm:)
Cột [A] ghi cao độ đạt được & cột ghi lại thể tích ta thu được thông qua thí nghiệm tại độ cao nào đó.
Nhiệm vụ của macro là:

(1) Thêm 10 dòng cho mỗi một độ cao nhận được;

(2) Lập các công thức cho tất cả các ô thuộc các dòng mới thêm nằm trên cột & [C] & công thức tính tại cột [D] (tức dòng cuối vừa thêm cho mỗi độ cao)
(Xin xem fần B trong hình)



/-)ể tiện theo dõi, mình xin tách ra 2 macro thực thi 2 nhiệm vụ trên lần lượt;

Đây là macro thêm chục dòng cho mỗi record:

PHP:
Option Explicit
Sub ChenDong()
Dim DuLieu, kq()
Dim Dong, Cot, I, J, K

DuLieu = Range([a4], [a65536].End(xlUp)).Resize(, 2).Value
ReDim kq(1 To UBound(DuLieu) * 10, 1 To 2)
For Dong = 1 To UBound(DuLieu) * 10 Step 10
    J = J + 1
    For Cot = 1 To 2
      kq(Dong, Cot) = DuLieu(J, Cot)
    Next
    For I = 1 To 9
      kq(Dong + I, 1) = kq(Dong, 1) & "." & I
    Next
Next
[a4].Resize(Dong - 1, 2) = kq
End Sub
& dưới đây là macro thêm các công thức theo iêu cầu đề bài:

Mã:
[b]Sub Group()[/b]
 Dim Rng As Range, Group As Range
 Dim jJ As Long
                   
 Set Rng = Range([B4], [B65500].End(xlUp)).SpecialCells(xlCellTypeConstants)
 For Each Group In Rng.Areas
    If Group.Row < 41 Then Group.Interior.ColorIndex = 34 + Group(1).Row Mod 9
    For jJ = 1 To 9
        Group.Offset(jJ).FormulaR1C1 = "=ROUND(R[-1]C+(R[" & 10 - jJ & "]C-R[-" & jJ & "]C)/10,2)"
        If Group.Row < 41 Then
            Group.Offset(jJ, 1).FormulaR1C1 = "=rc[-1]-r[-1]c[-1]"
            If jJ = 9 Then _
                Group.Offset(jJ, 2).FormulaR1C1 = "=rc[-2]+ rc[-1]"
        End If
    Next jJ
 Next Group
[b]End Sub[/b]
 

TQChanh

Member
Hội viên mới
Ðề: /(/ghên cứu về cách dùng biến mảng trong khi thêm dòng

BƯỚC ĐẦU NGHIÊN CỨU CÁCH SỬ DỤNG MẢNG TRONG VBA

Trong các macro dẫn ra ở các bài trên, chúng ta có 4 macro sử dụng đến biến mảng để xử lý dữ liệu. Các biến mảng này rất giúp ích cho chúng ta cải thiện tốc độ xử lý đáng kể. Nhất là với các CSDL đồ sộ & thường macro trước đây đã chạy một cách ì ạch.

Chúng ta hôm nay đi sâu vô tìm hiểu 1 trong 4 macro kể trên. Cụ thể là macro ở bài 11

Để tiện theo dõi, mình xin chép lại như dưới đây (& có bổ sung thêm chỉ số các dòng lệnh, để tiện fân tích cũng như theo dõi)

(#11 VỪA THÊM DÒNG VỪA THÊM DÒNG TỔNG LƯỢNG TRONG PROJECT)
PHP:
Sub InsertBlanlRowWithToTal() 
 Dim Rws As Long, wW As Long, ToTal As Double, zZ As Long 
 Dim Cls As Range 
  
1 Columns("H:H").Insert Shift:=xlToRight 
 Rws = Cells(Cells.Rows.Count, "B").End(xlUp).Row 
  
3 ReDim Arr(1 To 2 * Rws, 1 To 2):               ReDim ATmp(2 To Rws + 1) 
  
 ATmp() = Range("B2:B" & Rws + 1).Value: 
5 Arr(1, 1) = "Project ToTal":                   Arr(1, 2) = "GPE.COM" 
 Arr(Rws + 1, 2) = "A01" 
7 For wW = 2 To Rws 
    Arr(wW, 2) = "A" & zZ 
9    ToTal = ToTal + Cells(wW, "F").Value 
    If ATmp(wW - 1, 1) <> ATmp(wW, 1) And ATmp(wW, 1) <> "" Then 
11        zZ = zZ + 1 
        Arr(1 + Rws + zZ, 2) = "A" & zZ & zZ:   Arr(wW, 1) = ToTal 
13        ToTal = 0 
    End If 
GPE: 
16 Next wW 
 [h1].Resize(2 * Rws, 2).Value = Arr() 
18 [h1].CurrentRegion.Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlGuess, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
 Columns("I:I").ClearContents 
End Sub
:bdance:
Phần diễn dịch các dòng lệnh

Hai dòng lệnh trước dòng 1 (D1): Khai báo các biến cần dùng trongm macro này;
Trong đó hàng trên là các biến có kiểu dữ liện dạng số; Dòng dưới là biến đối tượng kiểu Range (vùng ô)

D1: Thêm 1 cột vô trước cột “H:H” (Lúc đó cột “H:H” trước đây sẽ trở thành cột “I:I”)

D2: Đem dòng cuối có dữ liệu thuộc cột gán vô biến Rws đã khai báo;

D3.1: Khai báo biến mảng có tên là “Arr” gồm 2*Rws dòng & 2 cột
D3.2: Khai báo thêm 1 biến mảng có tên là Atmp 1 chiều bắt đầu là 2 cho tới Rws +1 (Số cấu tử của mảng sẽ là Rws)

D4: Lấy vùng dữ liệu trên trang tính từ ô B2 đến ô trống dưới ô cuối có dữ liệu của cột đem gán vô mảng 1 chiều vừa khai báo.

D5.1 & D5.2 Gán trị chuỗi cho 2 cấu tử đầu của mảng Arr vừa khai báo;
Mục đích của việc này là: Đến gần hết macro chúng được gán lên trang tính & trở thành tiêu đề cột (trường) để thực hiện fương thức sắp, xếp.

D6: Ta fải gán trước vô mảng ở cấu tử thứ Rws+1. Thực hiện điều này vì ngay sau đây ta thiết lập vòng vòng lặp khào sát dữ liệu có trong cột kể từ dòng thứ 2 cho đến dòng Rws.
(Ở đây ta khảo sát từ dòng thứ 2 nên fải thêm trước dữ liệu cho 1 cấu tử; Nếu ta khảo sát từ dòng đầu thì không cần tiến hành công đoạn này.)

D7: Thiết lập vòng lặp duyệt dữ liệu từ dòng 2 đến dòng cuối (Rws) có dữ liệu cột .
(Vòng lặp này kết thúc tại dòng lệnh 16)

D8: Trong 1 chu kì lặp ta gán chuỗi gồm kí tự ‘A” & gắn với nó là trị trong biến zZ đang lưu giữ.
(Xin lưu í là , ngay khi đang khảo sát ô B2 (là dòng đầu tiên khảo sát) thì zZ đang có trị bằng 0. Sau này trị trong zZ sẽ tăng thêm 1 lúc cần thiết (Dòng lệnh 11))

D9: Lấy trị trong cột [F] cùng dòng đang khảo sát đem cộng tiếp vô biến ToTal đã khai báo. Làm việc này chi vậy? Vì nhiệm vụ đề ra cho macro là cần có số liệu tổng của mỗi nhóm project. (Các bạn xem lại hình trong bài 11 trên sẽ rõ hơn)

D10: Nếu đìều kiện trị đang chứa trong fần tử kế tiếp liền kề (wW +1) trong mảng Atmp khác với trị có trong fần tử wW đang khảo sát & trị đang khảo sát này khác rỗng thì thực thi các câu lệnh sau cho đến khi gặp câu lệnh End If gần nhất (D14)

D11: Ta đã nói bên trên;

D12.1: Fần tử thứ 1 + Rws + zZ thuộc cột 2 được gán trị chuỗi gồm "A" & zZ & zZ

D12.2: Fần tử thứ wW thuộc cột 1 của mảng được gán trị từ biến ToTal

Chú í:

(12.1) Trị chuỗi "A" & zZ & zZ sẽ giúp ích khi ta xếp lại dữ liệu trên trang tính theo cột [H]

(12.2) Vì đề bài iêu cầu cần ghi tổng của từng project lên dòng cuối có dữ liệu của project của nó (chứ không fải trên dòng mới thêm)

D13: Cho tham biến ToTal trở về 0 để chuẩn bị cho project kế tiếp;

D14: (Đã nêu)

D15: Đây là 1 nhãn & nó sinh ra để kiểm chương trình macro khi thực thi trước đây; Tuy nhiên tác giả đã quên xoá đi;

D16: (Đã đề cập bên trên)
D17: Đem các trị trong mảng Arr áp vô 2 cột [H:I].
Các bạn nên nhớ ở đây 1 điều là cột [H] là cột macro mới thêm vào & cột chính là cột [H] trước khi chạy macro;

D18: Áp dụng fương thức sắp xếp (như trong menu Data trong Excel ta thấy)
Ở đây, macro xếp trật tự theo cột (Xin các bạn xem kỹ tại #11 sẽ rõ hơn)

D19: Làm rỗng (trống) dữ liệu của cột


Thay cho fần kết:

Các macro có xài biến mảng có trong các bài #10, #13 & #16
Xin cảm ơn các bạn đã quan tâm!
 

TQChanh

Member
Hội viên mới
Ðề: Các cách thêm dòng mới vô 1 CSDL (cơ sở dữ liệu) đã sẵn

Nhờ giúp code tự động chèn thêm dòng bên trên

Em có bảng Định mức như ở file đính kèm (em chỉ để vài đầu việc cho nhẹ file up lên diẽn đàn cho tiện)
Em muốn các vật tư được phân tích bên dưới mỗi công việc sẽ được phân ra làm 3 loại: "Vật liệu", "Nhân công", "Máy thi công".
(Nghĩa là chèn thêm 1 dòng bên trên mỗi nhóm vật tư và điền vào đó "Vật liệu", "Nhân công" hay "Máy thi công")
Giống 3 các ô màu vàng em có làm ví dụ ở công việc cuối cùng trong file đính kèm.
Nhờ các anh giúp em đoạn code để có thể tự động làm công việc trên.
Vì trong định mức có đến hơn 50.000 dòng nên làm thủ công em ko biết khi nào xong
Mong các a giúp. Em cảm ơn!
Các bạn xem tại đây:
Nh? gi�p code t? ??ng ch�n th�m d�ng b�n tr�n
 

CẨM NANG KẾ TOÁN TRƯỞNG


Liên hệ: 090.6969.247

KÊNH YOUTUBE DKT

Kỹ thuật giải trình thanh tra BHXH

Đăng ký kênh nhé cả nhà

SÁCH QUYẾT TOÁN THUẾ


Liên hệ: 090.6969.247

Top