Xử lý và trộn dữ liệu trong cột

Namnguyen2942 · 21/12/19

Dạ em có 1 file excel cần xử lý như sau. Dữ liệu nằm ở cột D từ D1 ->D4000 (dữ liệu thuộc dạng text ạ. Bây giờ em muốn sửa lại dữ liệu cột D sao cho D1=D2, D3=D4,...., D3999=D4000.
Ví dụ: D1=abc, D2=xyz thì D1=D2=xyz, dẽ liệu e gồm 4000 hàng ạ.
Ai giỏi giúp em cách làm nhanh mà ko phải copy tay với. Em cảm ơn ạ

thuanfun · 21/12/19

Bạn chạy hàm VBA này là được.

Mã:

Sub DoIt()
    Application.ScreenUpdating = False
    Dim row As Integer
    For row = 1 To 4000
        If row Mod 2 = 1 Then
            ActiveSheet.Cells(row, 4).Value = ActiveSheet.Cells(row + 1, 4).Value
             'ActiveSheet.Cells(row, 4).Formula = "=D" & (row + 1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Namnguyen2942 · 21/12/19

thuanfun đã viết:

Bạn chạy hàm VBA này là được.

Mã:

Sub DoIt()
    Application.ScreenUpdating = False
    Dim row As Integer
    For row = 1 To 4000
        If row Mod 2 = 1 Then
            ActiveSheet.Cells(row, 4).Value = ActiveSheet.Cells(row + 1, 4).Value
             'ActiveSheet.Cells(row, 4).Formula = "=D" & (row + 1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Cảm ơn bạn, mình làm đc rồi, bạn có thể dạy mình cách làm code này đc ko, tại mình có mấy cái như này nữa

Namnguyen2942 · 21/12/19

Mình có dữ liệu ở cột G từ G1->G15000
Dữ liệu ở mỗi ô đều có dạng: [Text1]Text2
Bây giờ mình muốn Copy hàng loạt Text1 sang cột B (từ B1 -> B15000)
Text2 sang cột F (Từ F1 ->F15000)
Còn ở cột D thì là: D1, D2 = B3 ; D3, D4 = B5 .... D14998, D14999 = B15000
Xong rồi xóa dữ liệu cột G.

SA_DQ · 21/12/19

Mình không giỏi về hàm & chỉ có thể giúp bạn cái macro này thôi:

PHP:

Sub ChepGSangBVaSangF()
Dim VTri As Byte, Rws As Long, J As Long
Const DN As String = "]"
Dim StrC As String

Rws = [g1].End(xlDown).Row  'Dòng Cuói Có Du Liêu Cua Côt G        '
For J = 1 To Rws
    StrC = Cells(J, "G").Value
    VTri = InStr(StrC, DN)
    If VTri Then
        Cells(J, "B").Value = Mid(StrC, 2, VTri - 2)
        Cells(J, "F").Value = Mid(StrC, VTri + 1, Len(StrC))
        If J > 2 And (J Mod 2) = 1 Then
            Cells(J - 2, "D").Resize(2).Value = Cells(J, "B").Value
        End If
    End If
Next J
Range([g1], [g1].End(xlDown)).ClearContents  'Xóa Côt "G"    '
End Sub

batman1 · 21/12/19

SA_DQ đã viết:
Mình không giỏi về hàm & chỉ có thể giúp bạn cái macro này thôi:

Chủ thớt viết là có 15000 dòng dữ liệu. Thao tác trên sheet thế này thì có thể bỏ đi nhậu, lúc về vẫn chưa xong.

Chủ thớt:
- code phục vụ số dòng tùy ý. Cho phép dữ liệu trong cột G có ô trống đan xen.
- code tự xóa kết quả cũ khi chạy code với dữ liệu mới trong cột G.
- nếu dữ liệu cột G dùng cặp ngoặc khác, vd. "()" thì thay ở đầu code ký tự "]" thành ")"

Mã:

Sub TachDulieu()
Dim r As Long, lastRow As Long, so_chisole As Long, pos As Long, data(), result()
Const ngoac As String = "]"
    With ThisWorkbook.Worksheets("Sheet1")
'        luon luon phai xoa ket qua cu
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        Union(.Range("B1").Resize(lastRow), .Range("D1").Resize(lastRow), .Range("F1").Resize(lastRow)).ClearContents
'        lay cot G vao mang. Mang data cung duoc dung lam mang ket qua cho cot B
        data = .Range("G1:G" & .Cells(Rows.Count, "G").End(xlUp).Row + 1).Value
    End With
'    mang ket qua cho cot F
    ReDim result(1 To UBound(data), 1 To 1)
    For r = 1 To UBound(data) - 1   ' mang data da duoc lay du 1 dong
        pos = InStr(1, data(r, 1), ngoac)   ' tim ky tu ]
        result(r, 1) = Mid(data(r, 1), pos + 1) ' ket qua cho cot F
        If pos > 2 Then data(r, 1) = Mid(data(r, 1), 2, pos - 2)    ' code phuc vu ca du lieu rong nen phai kiem tra pos > 2
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("B1").Resize(UBound(data) - 1).Value = data ' nhap ket qua vao cot B
    ThisWorkbook.Worksheets("Sheet1").Range("F1").Resize(UBound(data) - 1).Value = result   ' nhap ket qua vao cot F
'    neu du lieu cot G co it nhat 3 dong thi moi thuc hien - cot it nhat la B3
'    trong data hien co ket qua cua cot B. Ta dung mang data lam mang ket qua cho cot D
    If UBound(data) > 3 Then
'        so cac chi so le trong mang data - 3, 5, 7, ... ung voi B3, B5, B7, ...
        so_chisole = (UBound(data) - 4) \ 2 + 1 ' nen nho la mang data duoc lay du 1 dong
        For r = 1 To so_chisole
            data(2 * r - 1, 1) = data(2 * r + 1, 1)
            data(2 * r, 1) = data(2 * r + 1, 1)
        Next r
        ThisWorkbook.Worksheets("Sheet1").Range("D1").Resize(2 * so_chisole).Value = data   ' nhap ket qua vao cot D
    End If
    ThisWorkbook.Worksheets("Sheet1").Range("G1").Resize(UBound(data) - 1).ClearContents    ' xoa cot G
End Sub

Namnguyen2942 · 21/12/19

batman1 đã viết:

Chủ thớt viết là có 15000 dòng dữ liệu. Thao tác trên sheet thế này thì có thể bỏ đi nhậu, lúc về vẫn chưa xong.

Chủ thớt:
- code phục vụ số dòng tùy ý. Cho phép dữ liệu trong cột G có ô trống đan xen.
- code tự xóa kết quả cũ khi chạy code với dữ liệu mới trong cột G.
- nếu dữ liệu cột G dùng cặp ngoặc khác, vd. "()" thì thay ở đầu code ký tự "]" thành ")"

Mã:

Sub TachDulieu()
Dim r As Long, lastRow As Long, so_chisole As Long, pos As Long, data(), result()
Const ngoac As String = "]"
    With ThisWorkbook.Worksheets("Sheet1")
'        luon luon phai xoa ket qua cu
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        Union(.Range("B1").Resize(lastRow), .Range("D1").Resize(lastRow), .Range("F1").Resize(lastRow)).ClearContents
'        lay cot G vao mang. Mang data cung duoc dung lam mang ket qua cho cot B
        data = .Range("G1:G" & .Cells(Rows.Count, "G").End(xlUp).Row + 1).Value
    End With
'    mang ket qua cho cot F
    ReDim result(1 To UBound(data), 1 To 1)
    For r = 1 To UBound(data) - 1   ' mang data da duoc lay du 1 dong
        pos = InStr(1, data(r, 1), ngoac)   ' tim ky tu ]
        result(r, 1) = Mid(data(r, 1), pos + 1) ' ket qua cho cot F
        If pos > 2 Then data(r, 1) = Mid(data(r, 1), 2, pos - 2)    ' code phuc vu ca du lieu rong nen phai kiem tra pos > 2
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("B1").Resize(UBound(data) - 1).Value = data ' nhap ket qua vao cot B
    ThisWorkbook.Worksheets("Sheet1").Range("F1").Resize(UBound(data) - 1).Value = result   ' nhap ket qua vao cot F
'    neu du lieu cot G co it nhat 3 dong thi moi thuc hien - cot it nhat la B3
'    trong data hien co ket qua cua cot B. Ta dung mang data lam mang ket qua cho cot D
    If UBound(data) > 3 Then
'        so cac chi so le trong mang data - 3, 5, 7, ... ung voi B3, B5, B7, ...
        so_chisole = (UBound(data) - 4) \ 2 + 1 ' nen nho la mang data duoc lay du 1 dong
        For r = 1 To so_chisole
            data(2 * r - 1, 1) = data(2 * r + 1, 1)
            data(2 * r, 1) = data(2 * r + 1, 1)
        Next r
        ThisWorkbook.Worksheets("Sheet1").Range("D1").Resize(2 * so_chisole).Value = data   ' nhap ket qua vao cot D
    End If
    ThisWorkbook.Worksheets("Sheet1").Range("G1").Resize(UBound(data) - 1).ClearContents    ' xoa cot G
End Sub

hay quá, mình cảm ơn bạn nhiều nhé

SA_DQ · 21/12/19

batman1 đã viết:
Chủ thớt viết là có 15000 dòng dữ liệu. Thao tác trên sheet thế này thì có thể bỏ đi nhậu, lúc về vẫn chưa xong.

Mình đã thử với >7500 dòng thì chỉ mất <5.1 gy thôi đó bạn

batman1 · 21/12/19

SA_DQ đã viết:
Mình đã thử với >7500 dòng thì chỉ mất <5.1 gy thôi đó bạn

Tức vd. 100 000 dòng cũng chỉ mất < 5 s?

SA_DQ · 21/12/19

batman1 đã viết:
Tức vd. 100 000 dòng cũng chỉ mất < 5 s?

Chuyện này mình xin nhường cho chủ bài đăng thôi, mình cố đến vậy thôi! Máy để bàn to đùng & cà tèng 5 năm rồi chưa nâng cấp mong được thông cảm!

batman1 · 21/12/19

SA_DQ đã viết:
Chuyện này mình xin nhường cho chủ bài đăng thôi, mình cố đến vậy thôi! Máy để bàn to đùng & cà tèng 5 năm rồi chưa nâng cấp mong được thông cảm!

Êêê, 5 năm mà cà tàng? Máy tôi 18 năm tuổi dùng XP cơ. RAM lúc đầu 512 MB, sau nâng lên 2*512 MB. Đĩa cứng ~ 28 GB.

SA_DQ · 21/12/19

Thì máy của mình ở tuỗi bẽ gãy sừng trâu đó; lần gần đây nhất thằng út nâng cấp cho,nhưng nó hạn chế chuyện xem fim nên cũng không mấy sáng tươi cho lắm. . . . .

Xin chúc các bạn cuối tuần vui vẻ!

Xử lý và trộn dữ liệu trong cột

Namnguyen2942

Thành viên mới

thuanfun

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

Namnguyen2942

Thành viên mới

Namnguyen2942

Thành viên mới

SA_DQ

/(hông là gì!

batman1

Thành viên gạo cội

Namnguyen2942

Thành viên mới

SA_DQ

/(hông là gì!

File đính kèm

batman1

Thành viên gạo cội

SA_DQ

/(hông là gì!

batman1

Thành viên gạo cội

SA_DQ

/(hông là gì!

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng