VBA TRÍCH LỌC DATA

[HTN033]

Chào Tất cả Mọi Người,

- Mình có 1 file excel cần tách data cột C ra thành từng phần và có kết quả như cột D.
- Do cột C là mình lấy từ rất nhiều nguồn của các thành viên nên format nó không giống nhau.
- Cột C phải có điều kiện ở cột B nữa " nếu ô trên và ô dưới giống nhau thì cột C phải giống nhau " như mình đã format.
Cảm Ơn Mọi người đã xem và giúp mình.

Thanks and best regards,
Nguyen Huu Toan

 

[CHAOQUAY]

Chào Tất cả Mọi Người,

- Mình có 1 file excel cần tách data cột C ra thành từng phần và có kết quả như cột D.
- Do cột C là mình lấy từ rất nhiều nguồn của các thành viên nên format nó không giống nhau.
- Cột C phải có điều kiện ở cột B nữa " nếu ô trên và ô dưới giống nhau thì cột C phải giống nhau " như mình đã format.
Cảm Ơn Mọi người đã xem và giúp mình.

Cảm ơn and best regards,
Nguyen Huu Toan

Chay thử sub dưới đây

Sub Split_()
Dim SArr
Dim DArr
Dim Res
Dim i, j, k
SArr = Sheet1.Range("a1").CurrentRegion
j = UBound(SArr)
ReDim Res(1 To j - 1, 1 To 1)

With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    .Pattern = "\w+"
    i = 2
    Do While i <= j
        If InStr(SArr(i, 3), ",") Then SArr(i, 3) = Replace(SArr(i, 3), " ", "")
        If SArr(i, 3) <> SArr(i - 1, 3) Then
            Set DArr = .Execute(SArr(i, 3))
            k = 0
            Res(i - 1, 1) = DArr(k)
        Else
            If SArr(i, 2) = SArr(i - 1, 2) Then
                Res(i - 1, 1) = Res(i - 2, 1)
            Else
                k = k + 1
                Res(i - 1, 1) = DArr(k)
            End If
        End If
        i = i + 1
    Loop
End With
With Sheet1
.Range("f2").Resize(j - 1, 1) = Res
End With
End Sub

Kết quả ví dụ của bạn từ dòng 14:21 hình như không đúng
Nếu số liệu đa dạng hơn nữa thì có thể phải chỉnh lại code

 

[HTN033]

Chay thử sub dưới đây

Sub Split_()
Dim SArr
Dim DArr
Dim Res
Dim i, j, k
SArr = Sheet1.Range("a1").CurrentRegion
j = UBound(SArr)
ReDim Res(1 To j - 1, 1 To 1)

With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    .Pattern = "\w+"
    i = 2
    Do While i <= j
        If InStr(SArr(i, 3), ",") Then SArr(i, 3) = Replace(SArr(i, 3), " ", "")
        If SArr(i, 3) <> SArr(i - 1, 3) Then
            Set DArr = .Execute(SArr(i, 3))
            k = 0
            Res(i - 1, 1) = DArr(k)
        Else
            If SArr(i, 2) = SArr(i - 1, 2) Then
                Res(i - 1, 1) = Res(i - 2, 1)
            Else
                k = k + 1
                Res(i - 1, 1) = DArr(k)
            End If
        End If
        i = i + 1
    Loop
End With
With Sheet1
.Range("f2").Resize(j - 1, 1) = Res
End With
End Sub

Kết quả ví dụ của bạn từ dòng 14:21 hình như không đúng
Nếu số liệu đa dạng hơn nữa thì có thể phải chỉnh lại code

'==================================
Chào Bạn,

cảm ơn bạn rất nhiều.

do file của mình có thay đổi ở cột B nhưng bạn chỉ quan tâm điều kiện 10 ký tự đầu của cột B, ( Cột C phải có điều kiện ở cột B nữa " nếu ô trên và ô dưới giống nhau thì cột C phải giống nhau " như mình đã format. )

Cảm ơn and best regards,
Nguyen Huu Toan

 

[Phuocam]

Việc nhập dấu phân cách Remarks các tổ không giống nhau:

Tổ 1 => dấu phẩy ,
Tổ 3 => dấu /
Tổ 4 => dấu phẩy và khoảng trắng
Tổ 5 => khoảng trắng

 

[CHAOQUAY]

...do file của mình có thay đổi ở cột B nhưng bạn chỉ quan tâm điều kiện 10 ký tự đầu của cột B, ( Cột C phải có điều kiện ở cột B nữa " nếu ô trên và ô dưới giống nhau thì cột C phải giống nhau " như mình đã format. )...

Cột B là so sánh toan bộ ký tự trong ô đó bạn. Chỗ này bạn =>

If SArr(i, 2) = SArr(i - 1, 2) Then

Trong file bài 1 : C14<>C13; C15<>C14 => tại D14, D15 dẫn xuống D21 có kết quả không đúng quy ước