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
Ðề: Các cách thêm dòng mới vô 1 CSDL (cơ sở dữ liệu) đã sẵn

Mình có trang tính dữ liệu (Tên là 'Du Lieu'), gồm nhiều dòng dữ liệu của các trướng từ cột [A] đến cột [Q]
Trong đó các trường từ cột trở đi có gán công thức trích dữ liệu từ cột [G]
Mình cần các bạn viết macro để copy các dòng này sang trang tính 'TONG HOP' với các điều kiện như sau:

Nếu cột [j] trở đi (đến cột [Q]) có dữ liệu thì tạo số dòng mới (tương ứng với số cột sau cột của dòng đang chép có dữ liệu)

Dữ liệu trong các cột sau sẽ được chép vô cột của dòng mới tạo



Xin các bạn xem file sẽ rõ hơn & chúc vui!
 

Đính kèm

TQChanh

Member
Hội viên mới
Ðề: Bài toán có thể giải quyết bằng cách thêm dòng mới như bài trước đây đã đề cập

Bài toán như sau:
Tôi có 2 hảng dữ liệu kiểu ngày trên 2 cột & [J] của trang tính "S1" như minh họa dưới đây:

Mã:
|[COLOR="silver"][B](Cột B)[/B][/COLOR] ||......|[COLOR="silver"][B](Cột J)[/B][/COLOR] |
|08/20/13||......|08/07/13|
|09/06/13||......|08/16/13|
|09/23/13||......|08/25/13|
|10/10/13||......|09/03/13|
|10/27/13||......|09/12/13|
|. . . . ||......|09/21/13|
|. . . . ||......|09/30/13|
|. . . . ||......|10/09/13|
|. . . . ||......|10/18/13|
Nhiệm vụ đề ra là dùng 1 macro để chuyển gộp 2 bảng số liệu này thành 1 ờ các cột [B...C] như dưới đây

Mã:
|[COLOR="silver"][B](Cột B)[/B][/COLOR] |[COLOR="silver"][B](Cột C)[/B][/COLOR] |
|08/20/13|08/07/13|
|[COLOR="white"]. . . . [/COLOR]|08/16/13|
|[COLOR="white"]. . . . [/COLOR]|08/25/13|
|09/06/13|09/03/13|
|09/23/13|09/12/13|
|[COLOR="white"]. . . . [/COLOR]|09/21/13|
|[COLOR="white"]. . . . [/COLOR]|09/30/13|
|10/10/13|10/09/13|
|10/27/13|10/18/13|
Yêu cầu như trang bảng là nhóm liên tục theo tháng ở cột theo số liệu đã xếp tăng dần của cột [J] (& đã được chép sang [C])

Bài toán này đã được đưa ra bỡi HYEN17 tại bài 839 của topic ?? vui v? VBA! - Page 84 & lời giải của VetMini
Các bạn có thể tham khảo.
Tuy nhiên xin báo trước các bạn là bài giải đó rất "hàn lâm", trình độ sơ sài VBA chưa thể với tới được;

Sau đây mình xin giới thiệu 1 macro đơn giản hơn để giải bài này qua các bước sau:

1./ Tạo vòng lặp duyệt từ trên xuống dưới dữ liệu tại cột [J], khi nào chuyển sang tháng khác thì ghi lại số ngày trong tháng đã duyệt qua vào nơi thích hợp
2./ Thêm số dòng cần thiết cho bảng số liệu tại
3./ Chép số liệu từ cột [J] sang cột [C]


Tuy nhiên nội dung macro mà mình đưa ra dưới đây là hơn khác. Vì dữ liệu thay vì ở cột [J] cùng trang tính, người ta đã đem nó sang trang tính khác (Các bạn chú ý tên trang tính sẽ rõ hơn)

Nội dung nó như sau:

PHP:
Option Explicit
Sub gpeTabl()
 Dim Cls As Range, Sh As Worksheet, Rng As Range, Cll As Range
 Dim SoNgay As Long, jJ As Long
 
 Sheet1.Select:         Set Sh = ThisWorkbook.Worksheets("Sheet2")
 Set Rng = Sh.Range(Sh.[b1], Sh.[b2].End(xlDown))
 For Each Cls In Range([b2], [b2].End(xlDown))
    jJ = jJ + 1
    If Month(Cls.Offset(1).Value) > Month(Cls.Value) Then
        For Each Cll In Rng
            If Month(Cll.Value) = Month(Cls.Value) Then SoNgay = 1 + SoNgay
        Next Cll
        Cls.Offset(, 1).Value = SoNgay - jJ
        jJ = 0:                         SoNgay = 0
    End If
 Next Cls
 
 For jJ = [C65500].End(xlUp).Row To 2 Step -1
    With Cells(jJ, "C")
        If .Value > 0 Then
            .Offset(1).Resize(.Value).EntireRow.Insert
        End If
    End With
 Next jJ
 Rng.Copy Destination:=[c2]
End Sub
 

TQChanh

Member
Hội viên mới
Ðề:Thêm dòng cho ngày còn thiếu của 1 CSDL

Các bạn cần hình dung sự việc như sau:

Tôi có trang tính mà từ [A4] cho đến [AI4] là tiêu đề của 1 CSDL đồ sộ; Trong đó trường 'InDate' ở cột [k:k] là trường ghi ngày tháng đáng được quan tâm & cột [C:C] là trường mã khách hàng

Đây là CSDL ghi lại hoạt động kinh doanh của các khách hàng thân thiết cho 1 công ti cỡ lớn.

Thêm nữa, tại [D2] tôi cần nhập ngày bắt đầu; Tại [G2] cần nhập ngày kết thúc.

TRong khoảng thời gian từ NgayBD cho đến NgayKT này có một số không ít khách hàng không tới quan hệ với công ti;
Tuy nhiên nhiệm vụ của tôi là mỗi khách hàng trong 1 ngày nào đó giữa NgayBD & NgayKT, trừ ngày CN
chưa đến giao dịch như cũng thêm cho người ấy 1 dòng
(Tất nhiên dòng thêm đó cần có dữ liệu thuộc về khác hàng đó trong 4 trường [A:C & K])

Xin mời các bạn tham khảo macro sau:

PHP:
Option Explicit
Sub AddRowsForMissingDates()
 Dim Cls As Range, Rng As Range, sRng As Range
 Dim Dat As Date, SoNgay As Integer, jJ As Long
     
 Sheet1.Select:                                     Dat = [D2].Value
 SoNgay = [g2].Value - Dat
 Sheets("GPE").Range("fName").Copy Destination:=[Ba1]
 Application.ScreenUpdating = False
 For Each Cls In [Ba1].CurrentRegion
    [ca2].Value = Cls.Value
    Range("B5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("CA1:CA2"), CopyToRange:=Range("CA4:CK4"), Unique:=False
    Set Rng = [ck5].Resize(35)
    Rng.NumberFormat = "mm/dd/yyyy"
    For jJ = 0 To SoNgay
        Set sRng = Rng.Find(Format(Dat + jJ, "mm/dd/yyyy"), , xlValues, xlWhole)
        If sRng Is Nothing Then
            If Weekday(Dat + jJ) > 1 Then
                With [A65500].End(xlUp).Offset(1)
                    .Resize(, 3) = [Ca5].Resize(, 3).Value
                    Cells(.Row, "K").Value = Dat + jJ
                End With
            End If
        Else
        End If
    Next jJ
 Next Cls
 Application.ScreenUpdating = True
 [B5].CurrentRegion.Sort Key1:=Range("A5"), Order1:=xlAscending, Key2:=Range("K5") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
    False, Orientation:=xlTopToBottom
End Sub
 

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

Mình có 1 CSDL như bảng sau
Mã:
[B]STT[/B]|[B]Ten KH[/B]|[B]Loại[/B] |[B]F.Loại[/B]|[B]Số[/B] |...
18 |Lâm KG|Dầu  | Lớn  |90 |...
19 |Lâm KG|Dầu  |Nhỏ   |83 |...
20 |Lâm KG|Tapan|Trung |56 |...      
21 |Mân RG|KK   | Lớn  |452|...  
...|. ..  |...  |...   |453|...
(Trong bảng liệt kê đơn hàng gỗ của các khách hàng ghi ở cột 2;
Tên loại gỗ được ghi ở cột thứ 3;
Cột 4 là fân loại gỗ, & cột 5 là ghi mã số
& . . . . . .)

Giờ cần 1 báo cáo theo 1 trật tự sắp xếp theo 3 cột [Loại gỗ], kế đến theo fân loại & cuối cùng là tăng dần theo [Mã số]
Hơn nữa, sau mỗi nhóm khác nhau 1 trong 3 tiêu chí này ta cộng số lượng của từng nhóm.

Thực ra đây sẽ là bài toán thêm dòng khi duyệt CSDL, Chỉ cần thay khác 1 trong 3 tiêu chí ta sẽ fải thêm dòng mới vô CSDL

Chi tiết các bạn có thể tham khảo tại Nh? gip t?ng h?p v phn lo?i hng ha (#8)
 

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

H?i c�ch ch�n th�m d�ng
Em có sheet s1 ở cột PART NÓ đã sắp sếp dữ liệu theo thứ tự, giờ muốn thêm một dòng trắng vào cuối đoạn những dòng dữ liệu trùng nhau như đoạn đầu trong sheet s2 mà không phải làm thủ công.
Các bác giúp em với!
PHP:
Option Explicit
Sub ChenDong()
 Dim Rws As Long, Col As Byte, J As Long, W As Byte, Th As Integer
 Dim Rng As Range, sArr()
  
 Sheets("S1").Select
 Set Rng = [A2].CurrentRegion
 Rws = Rng.Rows.Count
 Col = Rng.Columns.Count
 sArr() = Rng(1).Resize(Rws, Col).Value
 ReDim dArr(1 To 2 * Rws, 1 To Col + 1)
 For J = 1 To UBound(sArr())
    If J = 1 Then
        dArr(J, 1) = "GPE"
        For W = 1 To Col
            dArr(J, W + 1) = sArr(J, W)
        Next W
    Else
        dArr(J, 1) = sArr(J, 1)
        For W = 1 To Col
            dArr(J, W + 1) = sArr(J, W)
        Next W
    On Error Resume Next
        If sArr(J, 1) <> sArr(J + 1, 1) Then
            Th = Th + 1
            dArr(Rws + Th, 1) = sArr(J, 1) & "A"
        End If
    End If
 Next J
 If Err > 0 Then Err = 0
 Sheets("S2").Select
 [a1].Resize(2 * Rws, Col + 1).Value = dArr()
 [a1].CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
 Columns("A:A").Hidden = True 
End Sub
 

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

Em có sheet s1 ở cột PART-No đã sắp sếp dữ liệu theo thứ tự, giờ muốn thêm một dòng trắng vào cuối đoạn những dòng dữ liệu trùng nhau như đoạn đầu trong sheet s2 mà không phải làm thủ công.
Dữ liệu của bạn í thể hiện như bảng sau:

Mã:
Part-No|D28|D05|D06|...
   122K|123|234|654
   122K|987|654|321
   122k|159|753|456
   [COLOR="#FF0000"]146L[/COLOR]|[COLOR="#FF0000"]147[/COLOR]|[COLOR="#FF0000"]258[/COLOR]|[COLOR="#FF0000"]369[/COLOR] 
   900O|741|852|963
   ...|.|..|..
Khi đó bạn xài macro sau:

PHP:
Option Explicit
Sub ChenDong()
 Dim Rws As Long, Col As Byte, J As Long, W As Byte, Th As Integer
 Dim Rng As Range, sArr()
  
 Sheets("S1").Select
 Set Rng = [a2].CurrentRegion
 Rws = Rng.Rows.Count
 Col = Rng.Columns.Count
 sArr() = Rng(1).Resize(Rws, Col).Value
 ReDim dArr(1 To 2 * Rws, 1 To Col + 1)
 For J = 1 To UBound(sArr())
    For W = 1 To Col
        dArr(J, W + 1) = sArr(J, W)
    Next W
    If J = 1 Then
        dArr(J, 1) = "GPE"
    Else
        dArr(J, 1) = sArr(J, 1)
        On Error Resume Next
        If sArr(J, 1) <> sArr(J + 1, 1) Then
            Th = Th + 1
            dArr(Rws + Th, 1) = sArr(J, 1) & "A"
        End If
    End If
 Next J
 On Error GoTo 0
 Sheets("S2").Select       '<=|'
 [a2].Resize(2 * Rws, Col + 1).Value = dArr()
 [a2].CurrentRegion.Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
 Columns("A:A").Hidden = True '*'
End Sub
Em không biết gì về macro cả. Như macro ChenDong của bác muốn kết quả trả về ở ngay trên sheet s1 mà không phải thêm sheet s2 nữa thì làm thế nào ạ? mong bác chỉ giáo giúp!
Vậy bạn chỉ cần vô hiệu hóa dòng lệnh có mũi tên là được.
Chúc bạn thành công!

:dotphao:

H?i c�ch ch�n th�m d�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

Nhờ các anh, chị giúp em viết code chèn thêm dòng, và tính tổng từng tháng.
Dựa vào cột A (ngày chứng từ, chèn thêm 1 dòng trên và ghi Tháng 1, tháng 2, ... và tính tổng cho cột H và I của tháng đó.
Giống như những dòng em tô mẫu.
Trân trọng cảm ơn
PHP:
Option Explicit
Sub GPEDongTongCuaThang()
 Dim J As Byte, fDat As Date, lDat As Date, Rws As Long, Nam As Integer
 Dim MyFormat As String
 Dim WF As Object, Rng As Range, sRng As Range
 
 Sheets("334_2012").Select
 Set WF = Application.WorksheetFunction
 Set Rng = Range([b10], [b10].End(xlDown))
 Rws = [c9].CurrentRegion.Rows.Count
 MyFormat = Rng(1).Resize(Rws).NumberFormat
 Rng(1).Resize(Rws).NumberFormat = "MM/DD/yyyy"
 fDat = WF.Min(Rng):            lDat = WF.Max(Rng)
 Nam = Year(lDat):              ReDim Arr(1 To 3)
 Set Rng = [b9].Resize(Rws, 9)
 Application.ScreenUpdating = False
 For J = Month(fDat) To Month(lDat)
    [aa7].Value = DateSerial(Nam, J, 1)
    [ab7].Value = DateSerial(Nam, J + 1, 0)
    Arr(1) = WF.DMin(Rng, [b9], [aa4:ab5])
    Arr(2) = WF.DSum(Rng, [i9], [aa4:ab5])
    Arr(3) = WF.DSum(Rng, [j9], [aa4:ab5])
    Set sRng = Rng(1).Resize(Rws).Find(Format(Arr(1), "mm/dd/yyyy"), , xlValues, xlWhole)
    If Not sRng Is Nothing Then
        With sRng
            .EntireRow.Insert:                  .Offset(-1).Value = "Tháng " & Str(J)
            .Offset(-1, 7).Value = Arr(2):      .Offset(-1, 8).Value = Arr(3)
        End With
    End If
 Next J
 Application.ScreenUpdating = True
 Rng(2).Resize(Rws).NumberFormat = MyFormat
End Sub
Các bạn có thể xem file tại #4 ở đây: Vi?t code thm dng v tnh t?ng
 

TQChanh

Member
Hội viên mới
Ðề: Fương hướng giải quyết để "viết code chèn thêm dòng, và tính tổng từng tháng"

Ta biết rằng các ngày tháng GD (giao dịch) trong CSDL đó không hẵn là tháng đầu năm, cũng như trong 1 tháng không thể có GD ngay từ ngày đầu của tháng; Cũng có thể có tháng GD chỉ vài lần.

Vậy cho nên ta cần tìm ra ngày GD đầu tiên của các tháng

Việc này có thể hoàn toàn nhờ hàm DMIN(), mà cụ thể như =DMIN(B9:J1011,B9,AA4:AB5)

Ở đây,B9:J1011 là vùng chứa toàn bộ dữ liệu;
[b9] là ô đầu tiên của cột/Trường cần tìm giá trị min
& vùng điều kiện [AA4:AB5] là vùng chứa khoảng cần tìm; Thực tế trong bài là tìm từng giá trị min trong 1 tháng nhất định nào đó.

Trong macro ta thiết lập 1 vòng lặp khảo sát toàn bộ các tháng trong năm; Tháng nào có GD ta ghi vô biến mảng gồm 3 thành fần
(*) Thành fần đầu chứa trị min ngày GD trong tháng;
(*) Thành fần tiếp theo là tổng số lượng 'phát sinh nợ' trong tháng đó & thành fần cuối là tổng fát sinh có của tháng
Các tổng này cũng được tính nhờ hàm DSUM() thích ứng.

Sau khi ta có số liệu của tháng nào đó, ta đi tìm ngày MIN của tháng đó trong cột/trường ghi ngày tháng GD
Khi tìm ra ta thêm 1 dòng trống trên nó & ghi 2 số liệu tổng còn lại vô cột thích hợp của dòng trống này.

Như vậy CSDL của chúng ta có thứ tự ngày tháng GD tăng dần; Nếu không vậy, ta cần tiến hành sắp xếp theo trường này trước khi chạy macro.

Vài lời giải thích để rõ thêm cho bạn nào muốn tìm hiểu giải thuật của macro trên.
:khakha:
 

minhtiep178

New 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 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'
Chào bác TQChanh
Đoạn code của bác rất hay, công việc của em có một chút xíu liên quan đến bài toán trên. Vì đọc được bài của bác mà e cũng đang nghiên cứu về VBA để mở rộng hơn đoạn code của bác để phục vụ công việc mà khó quá. Ý tưởng của e là như thế này với bài toán của bác sau khi chạy VBA trường 'Ma' được như sau:
'Ma' |. . .
102C40047 2|. . .
102C40047 1|. . .
102C40047 0|. . .
2114A0054 3|. . .
2114A0054 2|. . .
2114A0054 1|. . .
2114A0054 0|. . .
10240V947 8-|. . .
10240V947 7|. . .
10240V947 6|. . .
10240V947 5|. . .
10240V947 4|. . .
10240V947 3|. . .
10240V947 2|. . .
10240V947 1|. . .
10240V947 0|. . .
21144G054 4|. . .
21144G054 3|. . .
21144G054 2|. . .
21144G054 1|. . .
21144G054 0|. . .
Bác giúp e với nhé!
 

TQChanh

Member
Hội viên mới
Ðề: Bạn thử chạy với macro sau:

PHP:
Option Explicit
Sub InsertRowsForNumbers()
 Dim Rws As Long, J As Long, NumFrom As Byte
 Dim Cls As Range, VTr As Byte, Dm As Byte
 Dim Ma As String
 
 Rws = [A2].End(xlDown).Row
 For J = Rws To 2 Step -1
    With Cells(J, "A")
        Ma = .Value:                VTr = InStr(Ma, " ")
        NumFrom = CLng(Mid(Ma, VTr + 1, 3))
        Ma = Left(Ma, VTr)
        .Offset(1).Resize(NumFrom).EntireRow.Insert
        For Each Cls In .Offset(1).Resize(NumFrom)
            Dm = Dm + 1
            Cls.Value = Ma & CStr(NumFrom - Dm)
        Next Cls
    End With
    Dm = 0
 Next J
End Sub
Sau đó đối chiếu các dòng lệnh giữa 2 macro để tìm ra những điều thú vị cho riêng mình!

Chúc vui khỏe nha! :oho:
 

minhtiep178

New Member
Hội viên mới
Ðề: Bạn thử chạy với macro sau:

Cám ơn bác TQChanh rất nhiều. Em cũng vừa chạy thử đoạn codde trên e thấy rất đúng ý em, nhưng thiếu một chút là các dứ liệu ở các cột bên cạnh cột A như cột B,C.... không = dữ liệu ở hàng trước nó. Và các câu lệnh ở D9--->D15 e chưa hiểu lắm. Bác giúp e nhé
 

TQChanh

Member
Hội viên mới
Ðề: Bạn thử chạy với macro sau:

Cám ơn bác TQChanh rất nhiều. Em cũng vừa chạy thử đoạn codde trên e thấy rất đúng ý em;
(1) Nhưng thiếu một chút là các dứ liệu ở các cột bên cạnh cột A như cột B,C.... không = dữ liệu ở hàng trước nó.

(2) Và các câu lệnh ở D9--->D15 e chưa hiểu lắm. Bác giúp e nhé
(1) Đề ra của bạn là vầy:
. . Ma. . . . .|. . .
102C40047 2|. . .
102C40047 1|. . .
102C40047 0|. . .
. . .|. . .
10240V947 8-|. . .
10240V947 7|. . .
10240V947 6|. . .
10240V947 5|. . .
10240V947 4|. . .
10240V947 3|. . .
10240V947 2|. . .
10240V947 1|. . .
10240V947 0|. .

Có nghĩa là cột trở đi "trống trơ" là những dấu ba chấm mà? Chúng có nghĩa gì nhiều đâu

(2)

PHP:
Option Explicit
Sub InsertRowsForNumbers()
 Dim Rws As Long, J As Long, NumFrom As Byte
 Dim Cls As Range, VTr As Byte, Dm As Byte
 Dim Ma As String
 4
 Rws = [A2].End(xlDown).Row
 6 For J = Rws To 2 Step -1
    With Cells(J, "A")
8        Ma = .Value:                VTr = InStr(Ma, " ")
        NumFrom = CLng(Mid(Ma, VTr + 1, 3))
10        Ma = Left(Ma, VTr)
        .Offset(1).Resize(NumFrom).EntireRow.Insert
 12       For Each Cls In .Offset(1).Resize(NumFrom)
            Dm = Dm + 1
 14           Cls.Value = Ma & CStr(NumFrom - Dm)
        Next Cls
    End With
    Dm = 0
 Next J
End Sub
D1-> D3: Khai báo các biến;
D5: Xác định dòng cuối chứa dữ liệu tại cột [A]
D6: Xác định vòng lặp từ dòng này cho tới dòng 2 của trang tính;
Vòng lặp này kết thúc tại dòng lệnh 18
D7: Tuyên cáo làm việc với ô ở cột [A] có chỉ số dòng trùng với tham biến J
D8: Gồm 2 câu lệnh:
Câu đầu: Lấy trị trong ô "Làm việc" cho vô biến đã khai báo
Câu sau: Xác định vị trí của khoảng trống của trị trong tham biến
D9: Cắt lấy số sau vị trí khoảng trống & biến nó thành trị kiểu số
D10: Thay đổ trị trong tham biến, thực chất là bỏ bớt fần sau của tham biến kể từ khoảng trống
D11: Tiến hành thêm dòng đúng bằng trị đã được số hóa bên trên
D12: Thiết lập vòng lặp duyệt toàn bộ các ô vừa thêm ở cột [A]
D13: Biến đếm số lần lặp của vòng lặp này được cọng thêm 1 sau mỗi lần lặp
D14: Gán trị tương ứng cho ô đang duyệt
D15: Kết thúc vòng lặp trong
. . . . .

:nuhon: :kinhhoang:
 
Sửa lần cuối:

minhtiep178

New Member
Hội viên mới
Ðề: Bạn thử chạy với macro sau:

(1) Đề ra của bạn là vầy:
. . Ma. . . . .|. . .
102C40047 2|. . .
102C40047 1|. . .
102C40047 0|. . .
. . .|. . .
10240V947 8-|. . .
10240V947 7|. . .
10240V947 6|. . .
10240V947 5|. . .
10240V947 4|. . .
10240V947 3|. . .
10240V947 2|. . .
10240V947 1|. . .
10240V947 0|. .

Có nghĩa là cột trở đi "trống trơ" là những dấu ba chấm mà? Chúng có nghĩa gì nhiều đâu

(2)

PHP:
Option Explicit
Sub InsertRowsForNumbers()
 Dim Rws As Long, J As Long, NumFrom As Byte
 Dim Cls As Range, VTr As Byte, Dm As Byte
 Dim Ma As String
 4
 Rws = [A2].End(xlDown).Row
 6 For J = Rws To 2 Step -1
    With Cells(J, "A")
8        Ma = .Value:                VTr = InStr(Ma, " ")
        NumFrom = CLng(Mid(Ma, VTr + 1, 3))
10        Ma = Left(Ma, VTr)
        .Offset(1).Resize(NumFrom).EntireRow.Insert
 12       For Each Cls In .Offset(1).Resize(NumFrom)
            Dm = Dm + 1
 14           Cls.Value = Ma & CStr(NumFrom - Dm)
        Next Cls
    End With
    Dm = 0
 Next J
End Sub
D1-> D3: Khai báo các biến;
D5: Xác định dòng cuối chứa dữ liệu tại cột [A]
D6: Xác định vòng lặp từ dòng này cho tới dòng 2 của trang tính;
Vòng lặp này kết thúc tại dòng lệnh 18
D7: Tuyên cáo làm việc với ô ở cột [A] có chỉ số dòng trùng với tham biến J
D8: Gồm 2 câu lệnh:
Câu đầu: Lấy trị trong ô "Làm việc" cho vô biến đã khai báo
Câu sau: Xác định vị trí của khoảng trống của trị trong tham biến
D9: Cắt lấy số sau vị trí khoảng trống & biến nó thành trị kiểu số
D10: Thay đổ trị trong tham biến, thực chất là bỏ bớt fần sau của tham biến kể từ khoảng trống
D11: Tiến hành thêm dòng đúng bằng trị đã được số hóa bên trên
D12: Thiết lập vòng lặp duyệt toàn bộ các ô vừa thêm ở cột [A]
D13: Biến đếm số lần lặp của vòng lặp này được cọng thêm 1 sau mỗi lần lặp
D14: Gán trị tương ứng cho ô đang duyệt
D15: Kết thúc vòng lặp trong
. . . . .

:nuhon: :kinhhoang:



Hihi :D. Xin lỗi Bác TQChanh nhé, e viết sai đề bài làm bác mất công :D
Đề bài của e thế này: Có 4 cột A, B, C, D co dữ liệu như sau:
1 aaaaaaaaa 11111111 xxxxxxx
2 bbbbbbbbb 22222222 yyyyyyy
3 ccccccccc 33333333 zzzzzzz
2 ddddddddd 44444444 kkkkkkk
3 eeeeeeeee 55555555 hhhhhhh

em muốn sau khi chạy VBA thi đc như sau:
1 aaaaaaaaa 11111111 xxxxxxx
0 aaaaaaaaa 11111111 xxxxxxx
2 bbbbbbbbb 22222222 yyyyyyy
1 bbbbbbbbb 22222222 yyyyyyy
0 bbbbbbbbb 22222222 yyyyyyy
3 ccccccccc 33333333 zzzzzzz
2 ccccccccc 33333333 zzzzzzz
1 ccccccccc 33333333 zzzzzzz
0 ccccccccc 33333333 zzzzzzz
2 ddddddddd 44444444 kkkkkkk
1 ddddddddd 44444444 kkkkkkk
0 ddddddddd 44444444 kkkkkkk
3 eeeeeeeee 55555555 hhhhhhh
2 eeeeeeeee 55555555 hhhhhhh
1 eeeeeeeee 55555555 hhhhhhh
0 eeeeeeeee 55555555 hhhhhhh


Dữ liệu trong Cột A có thể dạng number hoặc định dạng dd/mm/yy
Rất mong bác giúp đỡ
:nuhon:
 

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

Hiểu cái nào mần cái í trước; Còn dzụ dữ liệu ngày/tháng hỏi lại để rõ thêm
PHP:
Option Explicit
Sub InsertRowsForNumbers()
 Dim Rws As Long, J As Long, NumFrom As Byte, Dm As Byte
 Dim Cls As Range
 ReDim Arr(1 To 1, 1 To 3)
 
 Rws = [A2].End(xlDown).Row
 For J = Rws To 2 Step -1
    With Cells(J, "A")
        NumFrom = .Value
        .Offset(1).Resize(NumFrom).EntireRow.Insert
        Arr() = .Offset(, 1).Resize(, 3).Value
        For Each Cls In .Offset(1).Resize(NumFrom)
            Dm = Dm + 1
            Cls.Value = NumFrom - Dm
            Cls.Offset(, 1).Resize(, 3).Value = Arr()
        Next Cls
    End With
    Dm = 0
 Next J
End Sub

Dữ liệu kiểu ngày tháng thì thêm dòng theo số ngày hay sao đây bạn?
 

minhtiep178

New 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

Hiểu cái nào mần cái í trước; Còn dzụ dữ liệu ngày/tháng hỏi lại để rõ thêm
PHP:
Option Explicit
Sub InsertRowsForNumbers()
 Dim Rws As Long, J As Long, NumFrom As Byte, Dm As Byte
 Dim Cls As Range
 ReDim Arr(1 To 1, 1 To 3)
 
 Rws = [A2].End(xlDown).Row
 For J = Rws To 2 Step -1
    With Cells(J, "A")
        NumFrom = .Value
        .Offset(1).Resize(NumFrom).EntireRow.Insert
        Arr() = .Offset(, 1).Resize(, 3).Value
        For Each Cls In .Offset(1).Resize(NumFrom)
            Dm = Dm + 1
            Cls.Value = NumFrom - Dm
            Cls.Offset(, 1).Resize(, 3).Value = Arr()
        Next Cls
    End With
    Dm = 0
 Next J
End Sub

Dữ liệu kiểu ngày tháng thì thêm dòng theo số ngày hay sao đây bạn?
Hihi Thật lòng cám ơn bác rất nhiều. Nhờ có bác mà thời gian viết nhật ký của e giảm từ 3h còn 2h, mặc dù còn chút xíu lỗi nhỏ trong quá trình chạy code (Do đặc thù flie dữ liệu của em nó vậy).:love05:
 

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

; Mặc dù còn chút xíu lỗi nhỏ trong quá trình chạy code (Do đặc thù flie dữ liệu của em nó vậy).
Bạn có thể nói cho biết cái đặc thù của dữ liệu bạn đang sở hữu được không vậy?

Biết đâu ta cùng nhau khắc fục được thì sao?!

Chúc cuối tuần vui vẻ!
 

minhtiep178

New 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

Chúc cuối tuần vui vẻ![/B][/QUOTE]
:D cám ơn bác.
E sẽ gui 1 file cho bac, nhờ bác xem và giup e với. Dữ lieu của em ko có j đặc biêt nó chỉ có dung lượng lớn thôi :D
Cũng chúc bác cuối tuần vui vẻ! ( e ko có cuối tuần vì đi làm cả chủ nhật) :metwa:
View attachment 15047
 

Đính kèm

Sửa lần cuối:

TQChanh

Member
Hội viên mới
Ðề: Bạn xài macro này xem có thuận tiện hơn không:

PHP:
Option Explicit
Sub InsertRowsForNumbers()
 Dim Rws As Long, J As Long, NumFrom As Byte, Dm As Byte
 Dim Cls As Range
 ReDim Arr(1 To 1, 1 To 3)
  
 Rws = [A2].End(xlDown).Row
 Application.ScreenUpdating = False
 For J = Rws To 2 Step -1
    With Cells(J, "A")
        NumFrom = .Value
        If NumFrom = 0 Then GoTo GPE
        .Offset(1).Resize(NumFrom).EntireRow.Insert
        Arr() = .Offset(, 1).Resize(, 3).Value
        For Each Cls In .Offset(1).Resize(NumFrom)
            Dm = Dm + 1
            Cls.Value = NumFrom - Dm
            Cls.Offset(, 1).Resize(, 3).Value = Arr()
        Next Cls
    End With
    Dm = 0
GPE:
 Next J
 Application.ScreenUpdating = True
End Sub
:nhaykieumoi:
 

minhtiep178

New Member
Hội viên mới
Ðề: Bạn xài macro này xem có thuận tiện hơn không:

PHP:
Option Explicit
Sub InsertRowsForNumbers()
 Dim Rws As Long, J As Long, NumFrom As Byte, Dm As Byte
 Dim Cls As Range
 ReDim Arr(1 To 1, 1 To 3)
  
 Rws = [A2].End(xlDown).Row
 Application.ScreenUpdating = False
 For J = Rws To 2 Step -1
    With Cells(J, "A")
        NumFrom = .Value
        If NumFrom = 0 Then GoTo GPE
        .Offset(1).Resize(NumFrom).EntireRow.Insert
        Arr() = .Offset(, 1).Resize(, 3).Value
        For Each Cls In .Offset(1).Resize(NumFrom)
            Dm = Dm + 1
            Cls.Value = NumFrom - Dm
            Cls.Offset(, 1).Resize(, 3).Value = Arr()
        Next Cls
    End With
    Dm = 0
GPE:
 Next J
 Application.ScreenUpdating = True
End Sub
:nhaykieumoi:
Wow! Quá tuyệt vời. E ko biết nói j hơn nữa, thật lòng cám ơn bác TQchanh rất rất nhiều! Ko biết bác ở đầu e có thể mời bác đi uống nước đc ko?
 

TQChanh

Member
Hội viên mới
Ðề: Bạn xài macro này xem có thuận tiện hơn không:

Wow! Quá tuyệt vời. E ko biết nói j hơn nữa, thật lòng cám ơn bác TQchanh rất rất nhiều! Ko biết bác ở đầu e có thể mời bác đi uống nước đc ko?
(*) Bạn chưa nói là đã giảm đi từ 2 giờ xuống còn bao nhiêu giờ?

(*) Bạn nên nói trước rằng, hiện đang ngụ nơi mô?!, Mình đến cầu Ng. Tri Fương thì gần!
Chúc cuối tuần vui vẻ!:kingkong:
 

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