Nhờ viết code tự chèn thêm hoặc bớt dòng trong excel (1 người xem)

lamngoctien87 · 20/4/15

Mình không rành mấy cụ VBA nên nhờ mấy Pro viết giùm đoạn code này với.
1 sheet có danh sách liệt kê các tiêu chuẩn và mã số của nhóm tiêu chuẩn đó.
Và 1 sheet sẽ sử dụng các tiêu chuẩn đó.
Mong muốn của mình các tiêu chuẩn ở danh sách sẽ tự chèn thêm hoặc bớt đi khi sử dụng.
Cụ thể file đính kèm.
Cảm ơn các pro

ChanhTQ@ · 20/4/15

Bạn xem theo file ở bài #15: . . . . . . . . . . . . . . . . . .

lamngoctien87 · 20/4/15

Cảm ơn bác CanhTQ@. vẫn bị lỗi nhỏ bác
Lỗi thứ 1: Khi chọn mã số có số tiêu chuẩn nhiều thì định dạng chữ bị lỗi mỗi dòng 1 màu, chữ đậm nhạt. Do nó đè lên thuộc tính của thằng b.......
Có cách nào quy định khi chèn các dòng đó vào thì nó sẽ gắn thuộc tính nhất định. Ví dụ chữ đỏ hoặc xanh hết. Không sao chép thuộc tính của dòng dưoi không ạ.

Lỗi thứ 2 là: Khi tạo ra danh sách mã số ví dụ từ 1 đến 30 ở ô bôi vàng mà ở bên danh sách mã số chỉ có đến ví dụ 9 thì lúc chọn mã số ở ô bôi vàng báo lỗi như hình và không quay lại kiểu gì được cho dù chọn lại các mã nằm trong list đã tạo ra.

Cảm ơn bác giúp đỡ!

SA_DQ · 20/4/15

Thích thì đây chiu ngay thôi!

lamngoctien87 · 22/4/15

Cảm ơn bạn HYen17!
Bạn cho mình hỏi thêm chút nữa.
Khi mình áp dụng đoạn code trên sang một bảng khác thì lại không được mặc dù mình đã thay các giá trị rồi.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, Rng As Range, sRng As Range, Rg0 As Range, Cls As Range
Dim DgCu As Long, DgMoi As Long, J As Integer

If Not Intersect(Target, [P2]) Is Nothing Then
DgCu = [C8].Resize(13).Find("b.", , xlFormulas, xlPart).Row - 9
Set Sh = ThisWorkbook.Worksheets("Ma so")
Sh.[C65500].End(xlUp).Offset(1, -1).Value = "GPE.COM"
Set Rng = Sh.Range(Sh.[B4], Sh.[b65500].End(xlUp))
Set sRng = Rng.Find(Target.Value, , , xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing"
Else
Set Rg0 = Sh.Range(sRng.Offset(, 1), sRng.End(xlDown).Offset(-1, 1))
DgMoi = Rg0.Rows.Count
If DgMoi < DgCu Then
[C10].Resize(DgCu - DgMoi).EntireRow.Delete
ElseIf DgMoi > DgCu Then
[C10].Resize(DgMoi - DgCu).EntireRow.Insert
End If
For Each Cls In Rg0
J = J + 1
[C8].Offset(J).Value = Cls.Value
Next Cls
End If
Randomize: Target.Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End If
End Sub

bạn có thể hướng dẫn mình để áp dụng cho một bảng khác đoạn code trên được không?
Cảm ơn bạn!

lamngoctien87 · 22/4/15

Mọi ngừoi giúp đỡ mình chút.

SA_DQ · 23/4/15

Chưa rõ là bạn sẽ áp dụng sang bảng khác là như thế nào; Đành dịch tiếng Việt vậy:

Khi mình áp dụng đoạn code trên sang một bảng khác thì lại không được mặc dù mình đã thay các giá trị rồi.
bạn có thể hướng dẫn mình để áp dụng cho một bảng khác đoạn code trên được không?
Cảm ơn bạn!

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Rg0 As Range, Cls As Range
 Dim DgCu As Long, DgMoi As Long, J As Integer
 
1 If Not Intersect(Target, [P2]) Is Nothing Then
    DgCu = [C8].Resize(13).Find("b.", , xlFormulas, xlPart).Row - 9
3    Set Sh = ThisWorkbook.Worksheets("Ma so")
    Sh.[C65500].End(xlUp).Offset(1, -1).Value = "GPE.COM"
5    Set Rng = Sh.Range(Sh.[B4], Sh.[b65500].End(xlUp))
    Set sRng = Rng.Find(Target.Value, , , xlWhole)
7    If sRng Is Nothing Then
        MsgBox "Nothing"
9    Else
        Set Rg0 = Sh.Range(sRng.Offset(, 1), sRng.End(xlDown).Offset(-1, 1))
11        DgMoi = Rg0.Rows.Count
        If DgMoi < DgCu Then
13           [C10].Resize(DgCu - DgMoi).EntireRow.Delete
        ElseIf DgMoi > DgCu Then
15            [C10].Resize(DgMoi - DgCu).EntireRow.Insert
        End If
17        For Each Cls In Rg0
            J = J + 1
19            [C8].Offset(J).Value = Cls.Value
        Next Cls
21    End If
    Randomize:                      Target.Interior.ColorIndex = 34 + 9 * Rnd() \ 1
 End If
End Sub

Hai dòng trên D1: Khai báo các biến cần dùng;
D1: Nếu ta nhập/thay đổi trị tại ô [P2] thì macro sẽ thực thi các dòng lệnh cho đến hết
D2: Đem chỉ số dòng đang chứa cụm từ "b." gán vô biến đã khai báo
D3: Đem trang tính có tên là 'Ma So' gán vô biến đối tượng cũng đã khai báo
D4: Ô thuộc dòng cuối dữ liệu thuộc cột cộng thêm 1 được gán trị 'GPE.COM.'
Việc này ngỏ hầu xác định điểm cuối cần chép khi ta chọn mã cuối trong cột dữ liệu)
D5: Đem vùng dữ liệu cột này gán vô biến đã khai báo;
D6: Tiến hành fương thức 'Tìm kiếm' trị mà ta vừa nhập/thay đổi tại [P2]
D7-D8: Nếu không tìm thấy thì hiện hộp thoại thông báo "Không có"
D9: Nếu tìm thấy thì thực hiện các lệnh cho đến D21
D10: Đem vùng chứa các tiêu chuẩn của mã tìm thấy gán vô biến đối tượng Rg0.
Vùng này nằm ở cột bên fải liền kề với mã vừa tìm thấy.
D11: Đếm số ô thuộc biến đối tượng vừa gán trị & ấn nó vô biến có tên là 'DgMoi'
D12: Điều kiện nếu là trị trong DgMoi này nhỏ hơn trị trong biện DgCu thì thực hiện lệnh kế tiếp
D13: Xóa đi số dòng thừa kể từ dòng 10; Vì nếu khác ta sẽ fải định dạng lại những gì ta đã có từ lần chạy macro trước.
D14:Nếu ngược lại thì
D15: Thêm cho đủ số dòng; Cũng từ dòng 10, để các dòng vừa thêm có định dạng như các dòng cũ (như dòng 9)
D16: Kết thúc điều kiện thêm hay xóa dòng;
D17: Tạo vòng lặp duyệt qua hết các ô trong biến Rg0 (Chúng đang chứa các tiêu chuẩn liên quan đến mã)
Vòng lặp này kết thúc tại D20
D18: Tăng biến đếm thêm 1 đơn vị qua mỗi ô duyệt (thuộc Rg0)
D19: Chép trị trong ô đang duyệt vô hàng tương ứng với biến đến cách dòng 8 cố định (Đang chứa mệnh đề "- Các tiêu chuẩn về điều hòa không khí và thông gió:"
D22: Tô màu fù fiếm để báo là macro đã chạy xong!

Mong là giúp được bạn ít nhiều & chúc vui!

lamngoctien87 · 23/4/15

Cảm ơn bác rất nhiều. Em hiểu đôi chút và cũng áp dụng được có bảng khác rồi.

lamngoctien87 · 26/4/15

Mình gặp thêm một chút rắc rồi nữa thử mãi mà không có cách làm đưa lên mong các bạn trợ giúp.

lamngoctien87 · 27/4/15

bác nào dành chút thời gian giúp em vụ này với

SA_DQ · 27/4/15

Không fải là thêm & bớt dòng mà là ẩn những dòng thừa do trống dữ liệu

lamngoctien87 · 28/4/15

Cảm ơn bác nhiều. Bác cho em hỏi chút.
1. Nếu em bỏ đoạn code chèn danh sách tiêu chuẩn vào mục a thì bỏ đoạn code đó chỗ nào. (Chỉ dùng code chèn khối lượng vật tư thôi).

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) Dim Sh As Worksheet, Rng As Range, sRng As Range, Rg0 As Range, Cls As Range Dim Dg As Long, J As Integer  If Not Intersect(Target, [P2]) Is Nothing Then    [c9].Resize(10).ClearContents                           'Xóa Du Lieu Làn Truóc'    [c9].Resize(99).EntireRow.Hidden = False                'Hien Các Dòng Da An'    Set Sh = ThisWorkbook.Worksheets("Ma so")    Sh.[C65500].End(xlUp).Offset(1, -1).Value2 = "GPE.COM"    Set Rng = Sh.Range(Sh.[B4], Sh.[b65500].End(xlUp))    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)    If sRng Is Nothing Then        MsgBox "Nothing"    Else        Set Rg0 = Sh.Range(sRng.Offset(, 1), sRng.End(xlDown).Offset(-1, 1))        [c9].Resize(Rg0.Rows.Count).Value = Rg0.Value        Rows([c9].End(xlDown).Offset(1).Row & ":18").Hidden = True    End If    Randomize:                      Target.Interior.ColorIndex = 34 + 9 * Rnd() \ 12   Range("D58:G215").ClearContents    Set Sh = ThisWorkbook.Worksheets("Xuat")    Set Rng = Sh.Range(Sh.[A8], Sh.[A9999].End(xlUp))    Set sRng = Rng.Find(Target.Value)    If Not sRng Is Nothing Then        Range("D58:g215").ClearContents                      'Xóa Du Lieu Làn Truóc'        Set Rg0 = Sh.Range(sRng.Offset(, 4), sRng.End(xlDown).Offset(-1, 4)).Resize(, 4)        Rg0.Copy Destination:=[D58]        Dg = [d57].End(xlDown).Offset(1).Row        Rows(Dg & ":215").Hidden = True    Else        MsgBox "Khong Tháy"    End If End IfEnd Sub

2. Có thể merge từ ô D đến ô K rồi chèn dữ liệu bê bảng xuất vật tư được không. Hay bắt buộc chi đúng 1 ô trong cột D thôi.

SA_DQ · 28/4/15

Bác cho em hỏi chút.

1. Nếu em bỏ đoạn code chèn danh sách tiêu chuẩn vào mục a thì bỏ đoạn code đó chỗ nào. (Chỉ dùng code chèn khối lượng vật tư thôi).

2. Có thể merge từ ô D đến ô K rồi chèn dữ liệu bê bảng xuất vật tư được không. Hay bắt buộc chi đúng 1 ô trong cột D thôi.

(1) Bắt đầu từ dòng lệnh có đánh số trong macro đó.
Tuy nhiên có liên quan đến 1 số câu lệnh bên trên để xóa dữ liệu cũ,. . .

(2) Hoàn toàn không nên trộn ô kể cả khi dùng tuyền công thức.
VBA rất kị với việc trộn ô!

Chúc những ngày lễ nhiều niềm vui & hạnh fúc!

lamngoctien87 · 28/4/15

HYen17 đã viết:
(1) Bắt đầu từ dòng lệnh có đánh số trong macro đó.
Tuy nhiên có liên quan đến 1 số câu lệnh bên trên để xóa dữ liệu cũ,. . .

(2) Hoàn toàn không nên trộn ô kể cả khi dùng tuyền công thức.
VBA rất kị với việc trộn ô!

Chúc những ngày lễ nhiều niềm vui & hạnh fúc!

Cảm ơn bác!
Chúc bác có ngày nghỉ vui vẻ vẻ và hạnh phúc.
PS:
1. Em thử xóa mấy chỗ những nó vẫn cứ chèn thêm mấy dòng tiêu chuẩn đó.
2. Nếu em có thêm 1 sheet nữa. có 2 đoạn chèn 2 đoạn tiêu chuẩn khác nhau thì làm như thế nào à.

Mong bác chiếu cố giúp cho.

SA_DQ · 28/4/15

(2). Em thử xóa mấy chỗ những nó vẫn cứ chèn thêm mấy dòng tiêu chuẩn đó.
(1). Nếu em có thêm 1 sheet nữa. có 2 đoạn chèn 2 đoạn tiêu chuẩn khác nhau thì làm như thế nào à.

(1) Không biết có fải là iêu cầu cuối chưa í nhỉ? @#!^%

(2) ???

lamngoctien87 · 28/4/15

SA_DQ đã viết:
(1) Không biết có fải là iêu cầu cuối chưa í nhỉ?

(2) ???

Hi bác!
Cảm ơn bác nhiều! Tại em dốt văn tốt VBA nên mới hỏi nhiều. :-=

Ở ý 1 em hỏi là
1. Em thử xóa mấy chỗ những nó vẫn cứ chèn thêm mấy dòng tiêu chuẩn đó.
Tức sheet TC thiet ke bác gửi file đính kèm trên xóa đoạn code chèn tiêu chuẩn đi ấy ah. Chỉ dùng đoạn code chèn khối lượng thôi.
Em có thử tìm cách xóa nhưng không hiểu về code nên nó cứ báo lỗi.

Thân! Chúc bác vui vẻ!

SA_DQ · 28/4/15

Đang nhàn nhã

Bạn xem ở trang 'KLuong'

Đối chiếu với những gì bạn làm trước đó xem sao (?)

lamngoctien87 · 11/5/15

HYen17 đã viết:
Bạn xem ở trang 'KLuong'

Đối chiếu với những gì bạn làm trước đó xem sao (?)

Cảm ơn bác!
Vẫn bị lỗi một chút mong bác chiếu cố sửa giúp em cái.
Khi dữ liệu ở sheet Xuat nhiều thì sheet KLuong bị lỗi không hiện đầy đủ. Cụ thể em gửi file đính kèm.
https://www.dropbox.com/s/n08ot8hici3ldrl/ThemBoDongV4.xls?dl=0

SA_DQ · 11/5/15

/(hông xem được file; Có lẻ máy tính của mình ca tèng quá đi rồi!

lamngoctien87 · 12/5/15

Gửi file lỗi

Đây bác ơi....................... %#^#$

SA_DQ · 12/5/15

Bạn vô macro sự kiện của trang tính 'KLuong' đó & sửa 2 dòng lệnh có ghi chú thành vầy là được:

Mã:

    [d47].Resize(2[B]5[/B]0, 11).ClearContents                      'Xóa Du Lieu Làn Truóc'
    [d47].Resize(2[B]5[/B]1).EntireRow.Hidden = False               'Hien Các Dòng Da An'

Nhờ viết code tự chèn thêm hoặc bớt dòng trong excel (1 người xem)

Người dùng đang xem chủ đề này

Thành viên chính thức

File đính kèm

0901452không62

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

File đính kèm

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

File đính kèm

/(hông là gì!

File đính kèm

Thành viên chính thức

/(hông là gì!

File đính kèm

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

File đính kèm

/(hông là gì!

Thời gian đếm ngược.