Giúp viết Code chèn thêm dòng và gán dữ liệu như file mình đính kèm. (1 người xem)

[bogay]

Chèn thêm các dòng vào các hàng liền kề nhau và gán giá trị lấy từ Sheet Option. Mình xin cám ơn!

 

[Quang_Hải]

Chèn thêm các dòng vào các hàng liền kề nhau và gán giá trị lấy từ Sheet Option. Mình xin cám ơn!

Bạn xem file coi đúng ý chưa

Sub chen()
Dim dl(), kq(), i, j, k
dl = Range([A5], [A65536].End(3)).Resize(, 5).Value
ReDim kq(1 To UBound(dl) * 5, 1 To 5)
For i = 1 To UBound(dl)
  For j = 1 To 4
    kq(k + 1, j) = dl(i, j)
    kq(k + 1 + j, 3) = "Thang 1 -" & 2008 + j
  Next
  k = k + 5
Next
[A5].Resize(k - 1, 5) = kq
End Sub

 

[SA_DQ]

Bạn có thể tham khảo thêm các cách thêm dòng mới vô 1 CSDL ở đây: http://www.danketoan.com/forum/exce...oi-vo-1-csdl-co-so-du-lieu-da-san.182915.html

 

[bogay]

Bạn xem file coi đúng ý chưa

Sub chen()
Dim dl(), kq(), i, j, k
dl = Range([A5], [A65536].End(3)).Resize(, 5).Value
ReDim kq(1 To UBound(dl) * 5, 1 To 5)
For i = 1 To UBound(dl)
  For j = 1 To 4
    kq(k + 1, j) = dl(i, j)
    kq(k + 1 + j, 3) = "Thang 1 -" & 2008 + j
  Next
  k = k + 5
Next
[A5].Resize(k - 1, 5) = kq
End Sub

Mình cám ơn bạn. Nhưng bạn có thể sửa lại cho mình là lấy dự liệu ở Sheet option và link sang được không?

 

[Quang_Hải]

Mình cám ơn bạn. Nhưng bạn có thể sửa lại cho mình là lấy dự liệu ở Sheet option và link sang được không?

Bạn thay code này vào sễ lấy được dữ liệu của ô B1:B4

Sub chen()
Dim dl(), kq(), i, j, k, noidungchen
dl = Range([A5], [A65536].End(3)).Resize(, 5).Value
noidungchen = Sheet2.[b1:b4].Value
ReDim kq(1 To UBound(dl) * 5, 1 To 5)
For i = 1 To UBound(dl)
  For j = 1 To 4
    kq(k + 1, j) = dl(i, j)
    kq(k + 1 + j, 3) = noidungchen(j, 1)
  Next
  k = k + 5
Next
[A5].Resize(k - 1, 5) = kq
End Sub

 

[bogay]

Mình cám ơn bạn nhé.

 

[tiendo1988]

Em sửa code của anh "quanghai1969" ở bài #5 cho bài của mình nhưng khi chạy không ra được kết quả như mong muốn.

Nhờ anh "quanghai1969" và các ACE GPE xem sửa lại code giúp em trong file đính kèm.

Chân thành cảm ơn

 

[Quang_Hải]

Em sửa code của anh "quanghai1969" ở bài #5 cho bài của mình nhưng khi chạy không ra được kết quả như mong muốn.

Nhờ anh "quanghai1969" và các ACE GPE xem sửa lại code giúp em trong file đính kèm.

Chân thành cảm ơn

Tạm sửa thế này

Sub chen1()
Dim dl(), kq(), i, j, k, chen, C
dl = Range([B4], [B65536].End(3)).Resize(, 3).Value
chen = Sheet6.Range(Sheet6.[E1], Sheet6.[E65536].End(3)).Value
C = UBound(chen)
ReDim kq(1 To UBound(dl) * C, 1 To C)
For i = 1 To UBound(dl)
  For j = 1 To C
    If j < C Then kq(k + 1, j) = dl(i, j)
    kq(k + j, C) = chen(j, 1)
  Next
  k = k + C
Next
[B4].Resize(k, C) = kq
End Sub

 

[tiendo1988]

Cảm ơn anh "quanghai1969".

Anh ơi, sau khi chèn dòng và dữ liệu vào rồi. Giờ Em muốn Merge ở cột A, B, C lại tưng ứng với nhóm dữ liệu đã chèn vào ở cột D và đánh số thứ tự ở cột A.

Anh "quanghai1969" và ACE GPE giúp em nhé.

Xin cảm ơn!

 

[ChanhTQ@]

[thongbao]Giờ Em muốn Merge ở cột A, B, C lại tưng ứng với nhóm dữ liệu đã chèn vào ở cột D và đánh số thứ tự ở cột A.
[/thongbao]
Bạn tham khảo tiếp cái này:

Option Explicit
Sub MergeCells()
 Dim Rws As Long, J As Long
 
 Rws = [d65500].End(xlUp).Row
 For J = 4 To Rws Step 3
    With Cells(J, "A")
        .Value = (J - 1) \ 3
        .Resize(3).MergeCells = True
        .Offset(, 1).Resize(3).MergeCells = True
    End With
 Next J
End Sub

(Tranh thủ lúc 2H chưa có trên DĐ)

 

[tiendo1988]

Cảm ơn bác "ChanhTQ@", em đã chạy và thêm dòng
".Offset(, 2).Resize(3).MergeCells = True",
đã ra kết quả như mong đợi

 

[Quang_Hải]

Cảm ơn anh "quanghai1969".

Anh ơi, sau khi chèn dòng và dữ liệu vào rồi. Giờ Em muốn Merge ở cột A, B, C lại tưng ứng với nhóm dữ liệu đã chèn vào ở cột D và đánh số thứ tự ở cột A.

Anh "quanghai1969" và ACE GPE giúp em nhé.

Xin cảm ơn!

Viết cho bạn 1 code hoàn chỉnh theo cấu trúc file của bạn đây.

Sub chendong()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim chen(), I, II, J, K, Data(), kq(1 To 1000, 1 To 4), MerRng As Range
With Sheets("DM")
    chen = .Range(.[E1], .[E65536].End(3)).Value
End With
With Sheets("chen")
    Data = .Range(.[A4], .[C65536].End(3)).Value
    For I = 1 To UBound(Data)
        For J = 1 To 3
            For II = 1 To UBound(chen)
                kq(K + II, J) = Data(I, J)
                kq(K + II, 4) = chen(II, 1)
            Next
        Next
        K = K + UBound(chen)
    Next
    .[A4].Resize(K, 4) = kq
    Set MerRng = .Range(.[A4], .[A65536].End(3))
End With
For I = 1 To Application.Max(MerRng)
    With MerRng
        .AutoFilter 1, I
        .SpecialCells(12).MergeCells = True
        .Offset(, 1).MergeCells = True
        .Offset(, 2).MergeCells = True
        .AutoFilter
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[tiendo1988]

Cảm ơn bác "quanghai1969".
Trong cấu trúc dữ liệu của em, cột A:C thường thì em lọc và copy ở nơi khác qua nên số thứ tự sẽ không tuần tự từ 1, 2, ...
Bác "Quanghai1969" cùng ACE giúp em thêm: đánh số thứ tự lại cho cột A nhé.

Xin chân thành cảm ơn!

 

[trunganh20081]

Các ae giúp mình lập công thức đổi màu cho ngày

Mình cần lập công thức đổi màu trong ô quản lí date thuốc cho dễ nhìn: vd: date còn từ 30 đến 7 ngày thì màu vàng, từ 6 đến hết date là màu đỏ,
Ae nào biết cho mình xin công thức xuất những mặt hàng nao date còn 7 ngày ra file khác thì ok, xin cảm ơn ae giup đỡ.

mình không biết đưa file lên nên nhờ ké nhá, mong ae thông cảm. làm sao đưa file lên
​

 

[Quang_Hải]

Cảm ơn bác "quanghai1969".
Trong cấu trúc dữ liệu của em, cột A:C thường thì em lọc và copy ở nơi khác qua nên số thứ tự sẽ không tuần tự từ 1, 2, ...
Bác "Quanghai1969" cùng ACE giúp em thêm: đánh số thứ tự lại cho cột A nhé.

Xin chân thành cảm ơn!

Sửa code lại thế này chắc là được

Sub chendong()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim chen(), I, II, J, K, Data(), kq(1 To 1000, 1 To 4), MerRng As Range
With Sheets("DM")
    chen = .Range(.[E1], .[E65536].End(3)).Value
End With
With Sheets("chen")
    Data = .Range(.[A4], .[C65536].End(3)).Value
    For I = 1 To UBound(Data)
        For J = 2 To 3
            For II = 1 To UBound(chen)
                kq(K + II, J) = Data(I, J)
                kq(K + II, 4) = chen(II, 1)
                kq(K + II, 1) = I
            Next
        Next
        K = K + UBound(chen)
    Next
    .[A4].Resize(K, 4) = kq
    Set MerRng = .Range(.[A4], .[A65536].End(3))
End With
For I = 1 To Application.Max(MerRng)
    With MerRng
        .AutoFilter 1, I
        .SpecialCells(12).MergeCells = True
        .Offset(, 1).MergeCells = True
        .Offset(, 2).MergeCells = True
        .AutoFilter
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub