[Hỏi] Chèn thêm dòng có điều kiện !

[vl_vl]

Mình có 1 file dữ liệu bao gồm 2 Sheet . " Dữ liệu" và "DU LIEU SAU KHI TACH" . Trong sheet "Dulieu" có cột "Phòng Thi" . Cột này có thể có 1 đến 2,3 phòng ngăn cách nhau bởi Dấu "/" . Mình muốn chèn thêm dòng , cứ ứng với có bao nhiêu phòng thì mình sẽ chèn thêm bấy nhiêu dòng và điền phòng qua cột "PHÒNG THI CỤ THỂ".
Mình hay làm thủ công, nhưng lâu và dễ nhầm nữa. Bác nào viết giúp đoạn VBA với/.
Mình có gửi kèm file. Mong các bạn giúp đỡ mình với nha. Mình cảm ơn trước.

 

[ChanhTQ@]

Bạn cho chạy macro này & kiểm tra dữ liệu sau đó:

Option Explicit
Sub ThemDongDL()
 Dim Rws As Long, J As Long, W As Long, Dm As Byte, VTr As Byte
 Dim Tmp$, CuThe As String:                     Dim Arr()
 Const FC As String = "/"
 
 Sheets("Du Lieu").Select
 Rws = [b2].CurrentRegion.Rows.Count
 ReDim dArr(1 To 9 * Rws, 1 To 10)
 Arr() = [b2].Resize(Rws, 10).Value
 For J = 1 To UBound(Arr())
    If Arr(J, 6) = "" Then Exit For
    If InStr(Arr(J, 6), FC) Then
        Tmp = Arr(J, 6) & FC
        Do
            VTr = InStr(1, Tmp, FC)
            If VTr < 1 Then Exit Do
            CuThe = Left(Tmp, VTr - 1)
            W = W + 1:                          dArr(W, 1) = W
            For Dm = 2 To 10
                If Dm <> 8 Then
                    dArr(W, Dm) = Arr(J, Dm - 1)
                Else
                    dArr(W, 8) = CuThe
                End If
            Next Dm
            Tmp = Mid(Tmp, VTr + 1, Len(Tmp))
        Loop
    Else
        W = W + 1:                              dArr(W, 1) = W
        For Dm = 2 To 10
            If Dm <> 8 Then
                dArr(W, Dm) = Arr(J, Dm - 1)
            Else
                dArr(W, 8) = Arr(J, 6) & "."
            End If
        Next Dm
    End If
 Next J
 [L2].Resize(W, 10).Value = dArr()
End Sub

 

[vl_vl]

Cảm ơn bạn . Hiện tại đã chạy nhưng cho mình hỏi thêm 3 vấn đề nữa là:
- Cột phòng thi chỉ có 1 phòng thì ko cần phải chuyển qua cột "phòng thi cụ thể " Hiện tại tool đang chuyển qua lun và có thêm dấu "." nữa.
- Mình muốn tăng thêm số dòng dữ liệu trong sheet "Du lieu" thì phải làm thế nào ? Hiện tại chỉ có 10 dòng dữ liệu.
- Mình muồn tách xong thì copy sang một sheet mới có đc ko ?

 

[ChanhTQ@]

Cảm ơn bạn . Hiện tại đã chạy nhưng cho mình hỏi thêm 3 vấn đề nữa là:
(1) Cột phòng thi chỉ có 1 phòng thì ko cần phải chuyển qua cột "phòng thi cụ thể " Hiện tại tool đang chuyển qua lun và có thêm dấu "." nữa.
(2) Mình muốn tăng thêm số dòng dữ liệu trong sheet "Du lieu" thì phải làm thế nào ? Hiện tại chỉ có 10 dòng dữ liệu.
(3) Mình muồn tách xong thì copy sang một sheet mới có đc ko ?

(1) Bạn vô hiệu hóa dòng lệnh này đi vậy:

[FONT=Courier New][COLOR=#0000bb]dArr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]W[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]8[/COLOR][COLOR=#007700]) = [/COLOR][COLOR=#0000bb]Arr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]J[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]6[/COLOR][COLOR=#007700]) & [/COLOR][/FONT][COLOR=#dd0000][FONT=Courier New]"." [/FONT][/COLOR]

(2) Thì bạn thử tăng lên đến chán thì thôi; Nhưng đảm bảo không có dòng trống/trắng xem giữa chúng.

(3) Thì thay

[FONT=Courier New][COLOR=#007700][[/COLOR][COLOR=#0000bb]L2[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000bb]Resize[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]W[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]10[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Value [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]dArr[/COLOR][/FONT][COLOR=#007700][FONT=Courier New]() [/FONT][/COLOR]

Bằng dòng lệnh:

Sheets("XYZ").Range("Rng").Reize(w,10).value=dArr()

Ở đây 'XYZ' là tên trang tính cần chép đến & Rng là địa chỉ ô trái trên nhất cần có dữ liệu. (Với câu lệnh cũ thì tại [L2] của trang hiện hành.)

 

[vl_vl]

Sheets("XYZ").Range("Rng").Reize(w,10).value=dArr()

Câu lệnh này e sửa lại thì báo lỗi
Sheets("copy").Range("B5").Reize(w,10).value=dArr()

 

[SA_DQ]

Câu lệnh này e sửa lại thì báo lỗi
Sheets("copy").Range("B5").Reize(w,10).value=dArr()

(1) Nó báo câu gì vậy bạn, có thể đưa lên đây được không?

(2) Đoán là lỗi chính tả, trong các trường hợp sau đây

Tên trang tính không trùng với thực tế;
'Reize' là không có nghĩa lí với VBA;

(3) Xem lại w là bao nhiêu hiện thời, trước khi 'Copy'

 

[doatmenhhon]

Góp vui với file dưới đây. Dữ liệu được xuất sang sheet2