Lọc dữ liệu có nguyên tắc để tạo thành các ô dữ liệu mới

[pham ha 94]

Như tiêu đề, mình muốn nhờ các bác giúp, khi dữ liệu tại cột C có dữ liệu nhiều hơn 4 ký tự thì sẽ tạo ra dòng mới để đưa mã khóa xuống dòng mới.
Ví dụ 2301, 2302 thì sẽ tạo thành 2 dòng tại cột C có nội dung là 2301 và dòng 2302

 

[Thóc Sama]

Như tiêu đề, mình muốn nhờ các bác giúp, khi dữ liệu tại cột C có dữ liệu nhiều hơn 4 ký tự thì sẽ tạo ra dòng mới để đưa mã khóa xuống dòng mới.
Ví dụ 2301, 2302 thì sẽ tạo thành 2 dòng tại cột C có nội dung là 2301 và dòng 2302

Bạn chạy thử code sau và kiểm tra lại kết quả nha

Option Explicit
Sub GPE()
    Dim i%, k%, j%, Arr(), b%, dc%
    Dim a%, Res(1 To 1000, 1 To 4)
    Arr = Range("A2:D6").Value
    For i = 1 To UBound(Arr)
        Arr(i, 3) = Replace(Arr(i, 3), ".", "|")
        Arr(i, 3) = Replace(Arr(i, 3), ",", "|")
    Next i
    For i = 1 To UBound(Arr)
        If IsNumeric(Arr(i, 3)) Then
            k = k + 1
            For j = 1 To 4
                 Res(k, j) = Arr(i, j)
            Next j
        Else
            For a = 1 To Len(Arr(i, 3))
                If Mid(Arr(i, 3), a, 1) = "|" Then dc = dc + 1
            Next a
            If dc > 0 Then
                For b = 0 To dc
                    k = k + 1
                    For j = 1 To 2
                        Res(k, j) = Arr(i, j)
                    Next j
                    Res(k, 3) = Split(Arr(i, 3), "|")(b)
                    Res(k, 4) = Arr(i, 4)
                Next b
            End If
            dc = 0
        End If
    Next i
    If k Then
        Range("G2:J1000").ClearContents
        Range("G2").Resize(k, 4).Value = Res
    End If
    MsgBox "Xong roi"
End Sub

 

[HieuCD]

Như tiêu đề, mình muốn nhờ các bác giúp, khi dữ liệu tại cột C có dữ liệu nhiều hơn 4 ký tự thì sẽ tạo ra dòng mới để đưa mã khóa xuống dòng mới.
Ví dụ 2301, 2302 thì sẽ tạo thành 2 dòng tại cột C có nội dung là 2301 và dòng 2302

Mã khóa luôn có 4 ký tự

Sub ABC()
  Dim arr(), res(), srRes&, i&, k&, j&, L&
 
  arr = Range("A2", Range("D2").End(xlDown)).Value
  For i = 1 To UBound(arr)
    arr(i, 3) = Replace(arr(i, 3), " ", "")
    srRes = srRes + Int(Len(arr(i, 3)) + 1 / 4)
  Next i
  ReDim res(1 To srRes, 1 To 4)
  For i = 1 To UBound(arr)
    L = Len(arr(i, 3))
    For j = 1 To L Step 5
      k = k + 1
      res(k, 1) = arr(i, 1): res(k, 2) = arr(i, 2)
      res(k, 3) = Mid(arr(i, 3), j, 4)
      res(k, 4) = arr(i, 4)
    Next j
  Next i
  i = Range("G1000000").End(xlUp).Row
  If i > 1 Then Range("G2:J" & i).ClearContents
  Range("G2").Resize(k, 4).Value = res
End Sub

 

[Nhattanktnn]

srRes = srRes + Int(Len(arr(i, 3)) + 1 / 4)

Bác Hiếu cho em hỏi +1/4 là dư thừa hay là có ý đồ gì?

 

[HieuCD]

Bác Hiếu cho em hỏi +1/4 là dư thừa hay là có ý đồ gì?

Mình nhập sai tùm lum, hên là code chạy được
srRes = srRes + Int((Len(arr(i, 3)) + 1) / 5)

 

[pham ha 94]

cảm ơn bác nhiều, EM làm được rồi

Bài đã được tự động gộp: 1/4/23

Bạn chạy thử code sau và kiểm tra lại kết quả nha

Option Explicit
Sub GPE()
    Dim i%, k%, j%, Arr(), b%, dc%
    Dim a%, Res(1 To 1000, 1 To 4)
    Arr = Range("A2:D6").Value
    For i = 1 To UBound(Arr)
        Arr(i, 3) = Replace(Arr(i, 3), ".", "|")
        Arr(i, 3) = Replace(Arr(i, 3), ",", "|")
    Next i
    For i = 1 To UBound(Arr)
        If IsNumeric(Arr(i, 3)) Then
            k = k + 1
            For j = 1 To 4
                 Res(k, j) = Arr(i, j)
            Next j
        Else
            For a = 1 To Len(Arr(i, 3))
                If Mid(Arr(i, 3), a, 1) = "|" Then dc = dc + 1
            Next a
            If dc > 0 Then
                For b = 0 To dc
                    k = k + 1
                    For j = 1 To 2
                        Res(k, j) = Arr(i, j)
                    Next j
                    Res(k, 3) = Split(Arr(i, 3), "|")(b)
                    Res(k, 4) = Arr(i, 4)
                Next b
            End If
            dc = 0
        End If
    Next i
    If k Then
        Range("G2:J1000").ClearContents
        Range("G2").Resize(k, 4).Value = Res
    End If
    MsgBox "Xong roi"
End Sub

Cảm ơn bác nhiều, cách này khá hay, đúng luôn với mong muốn ạ