Nhờ các bác viết hộ em đoạn code VBA

[kiendaide1]

Em muốn tách dư liệu trước từng dấu phẩy ở cột C thành từng dong và các dư liệu ở các cột khác tự động copy theo dư liệu đã tách ở cột C tương ứng. em có dư liệu và sheet dư liệu tách mong muốn các bác giúp hộ em với ạ

 

[BuiQuangThuan]

Em muốn tách dư liệu trước từng dấu phẩy ở cột C thành từng dong và các dư liệu ở các cột khác tự động copy theo dư liệu đã tách ở cột C tương ứng. em có dư liệu và sheet dư liệu tách mong muốn các bác giúp hộ em với ạ

Dùng Split để tách ra nhé

 

[Hoàng Tuấn 868]

Dùng Spit để tách ra nhé

Hàm này mới quá nhỉ. Nghe giống như tốc độ cao.

 

[Quang_Hải]

Em muốn tách dư liệu trước từng dấu phẩy ở cột C thành từng dong và các dư liệu ở các cột khác tự động copy theo dư liệu đã tách ở cột C tương ứng. em có dư liệu và sheet dư liệu tách mong muốn các bác giúp hộ em với ạ

Thử code này

Sub Tach()
Dim sArr(), dArr(), i As Long, n As Long, Tach As Variant, k As Long
With Sheets("Sheet1")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(3)).Resize(, 3).Value
End With
ReDim dArr(1 To UBound(sArr) * 100, 1 To 3)
For i = 1 To UBound(sArr)
    If sArr(i, 3) <> Empty Then
        Tach = Split(sArr(i, 3), ",")
        For n = LBound(Tach) To UBound(Tach)
            k = k + 1
            dArr(k, 1) = k
            dArr(k, 2) = sArr(i, 2)
            dArr(k, 3) = CDate(Tach(n))
        Next
    Else
        k = k + 1
        dArr(k, 1) = k
        dArr(k, 2) = sArr(i, 2)
    End If
Next
Sheets("Sheet1").Range("D3").Resize(k, UBound(dArr, 2)) = dArr
End Sub

 

[kiendaide1]

Thử code này

Sub Tach()
Dim sArr(), dArr(), i As Long, n As Long, Tach As Variant, k As Long
With Sheets("Sheet1")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(3)).Resize(, 3).Value
End With
ReDim dArr(1 To UBound(sArr) * 100, 1 To 3)
For i = 1 To UBound(sArr)
    If sArr(i, 3) <> Empty Then
        Tach = Split(sArr(i, 3), ",")
        For n = LBound(Tach) To UBound(Tach)
            k = k + 1
            dArr(k, 1) = k
            dArr(k, 2) = sArr(i, 2)
            dArr(k, 3) = CDate(Tach(n))
        Next
    Else
        k = k + 1
        dArr(k, 1) = k
        dArr(k, 2) = sArr(i, 2)
    End If
Next
Sheets("Sheet1").Range("D3").Resize(k, UBound(dArr, 2)) = dArr
End Sub

Em cam ơn bác ạ

 

[BuiQuangThuan]

Hàm này mới quá nhỉ. Nghe giống như tốc độ cao.

Hihi. em đã cập nhật lại từ sai ạ

 

[VetMini]

Sao quý vị sốt sắng quá nhỉ?
Thớt đã ở đây 10 năm mà vẫn giữ thói viết "tiêu đề chung chung"
Có lẽ thấy cũng chả sao cho nên ăn quen.