Xử lý dữ liệu theo điều kiện (1 người xem)

[vanvan9697]

Em có sử dụng 1 Function trên diễn đàn về lấy dữ liệu từ dòng trên xuống dòng dưới theo điều kiện. Tuy nhiên khi sử dụng với dữ liệu này không có 1 điều kiện lấy đồng nhất nên không dùng được Function này. Em rất mong anh (chị) Trong diễn đàn giúp em xử lý dữ liệu trong file. Kết quả em để bên sheet Kết Quả ạ

Function LayDL(rng As Range, Ma As String)
    Dim Rws As Long, W As Long, Col As Byte, Cot As Byte   '*'
    Dim tmp As String
    Dim Cls As Range
    Rws = rng.Rows.Count
    Col = rng.Columns.Count + 1                '*'
    ReDim arr(1 To Rws, 1 To Col) As String    '*'
    For Each Cls In rng(1).Resize(Rws)
        If InStr(Cls.Value, Ma) Then
            tmp = Cls.Value
        Else
            W = W + 1
            arr(W, 1) = tmp:    arr(W, 2) = Cls.Value
1                                For Cot = 3 To Col
            arr(W, Cot) = Cls.Offset(, Cot - 2)
2                                Next Cot
        End If
    Next Cls
    LayDL = arr()
End Function

 

[SA_DQ]

"Lấy đồng nhất" là lấy NTN?

 

[vanvan9697]

"Lấy đồng nhất" là lấy NTN?

Dạ em muốn lấy dữ liệu Theo Kết quả ở sheet Kết Quả anh Ạ!. Còn "đồng nhất" của em là dạng không biết điều kiện gì như Function như phải dùng với điều kiện là "Bán hàng" chẳng hạn anh ạ

 

[vanaccex]

Cái này thấy xử lý bằng tay cũng nhanh mà nhỉ !

 

[vanvan9697]

Cái này thấy xử lý bằng tay cũng nhanh mà nhỉ !

Dạ em mong muốn sử dụng VBa bởi dữ liệu của em rất nhiều ạ !

 

[vanvan9697]

Anh ( chị ) giúp em đoạn sub này với ạ !

 

[snow25]

Em có sử dụng 1 Function trên diễn đàn về lấy dữ liệu từ dòng trên xuống dòng dưới theo điều kiện. Tuy nhiên khi sử dụng với dữ liệu này không có 1 điều kiện lấy đồng nhất nên không dùng được Function này. Em rất mong anh (chị) Trong diễn đàn giúp em xử lý dữ liệu trong file. Kết quả em để bên sheet Kết Quả ạ

Function LayDL(rng As Range, Ma As String)
    Dim Rws As Long, W As Long, Col As Byte, Cot As Byte   '*'
    Dim tmp As String
    Dim Cls As Range
    Rws = rng.Rows.Count
    Col = rng.Columns.Count + 1                '*'
    ReDim arr(1 To Rws, 1 To Col) As String    '*'
    For Each Cls In rng(1).Resize(Rws)
        If InStr(Cls.Value, Ma) Then
            tmp = Cls.Value
        Else
            W = W + 1
            arr(W, 1) = tmp:    arr(W, 2) = Cls.Value
1                                For Cot = 3 To Col
            arr(W, Cot) = Cls.Offset(, Cot - 2)
2                                Next Cot
        End If
    Next Cls
    LayDL = arr()
End Function

Bạn dùng code này xem nhé.

Sub xoa()
Dim a As Long, i As Long, j As Long, lr As Long
Dim arr, arr1
With Sheet1
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    arr = .Range("A1:G" & lr).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 7)
    For i = 1 To UBound(arr, 1)
       If arr(i, 5) <> Empty Then
         a = a + 1
          For j = 1 To 7
              arr1(a, j) = arr(i, j)
           Next j
       End If
    Next i
End With
With Sheet2
      lr = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A1:G" & lr).ClearContents
      If a Then .Range("A1").Resize(a, 7).Value = arr1
End With
End Sub

 

[vanvan9697]

Bạn dùng code này xem nhé.

Sub xoa()
Dim a As Long, i As Long, j As Long, lr As Long
Dim arr, arr1
With Sheet1
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    arr = .Range("A1:G" & lr).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 7)
    For i = 1 To UBound(arr, 1)
       If arr(i, 5) <> Empty Then
         a = a + 1
          For j = 1 To 7
              arr1(a, j) = arr(i, j)
           Next j
       End If
    Next i
End With
With Sheet2
      lr = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A1:G" & lr).ClearContents
      If a Then .Range("A1").Resize(a, 7).Value = arr1
End With
End Sub

Dạ ở Sheet Dữ liệu gốc nếu như không có cột D đã xử lý rồi thi kết quả chưa chính xác anh ạ. Em muốn sinh ra cột D và Kết quả như ở sheet kết quả anh ạ
Em gửi anh lại File trước khi em xử lý cột D anh ạ

 

[vanvan9697]

Dạ ở Sheet Dữ liệu gốc nếu như không có cột D đã xử lý rồi thi kết quả chưa chính xác anh ạ. Em muốn sinh ra cột D và Kết quả như ở sheet kết quả anh ạ
Em gửi anh lại File trước khi em xử lý cột D anh ạ

Anh (chị) xem giúp em vấn đề này với ạ

 

[snow25]

Anh (chị) xem giúp em vấn đề này với ạ

Bạn dùng code này xem.

Sub xoa()
Dim a As Long, i As Long, j As Long, lr As Long, dk As String
Dim arr, arr1
With Sheet1
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    arr = .Range("A1:f" & lr).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 7)
    For i = 1 To UBound(arr, 1)
       If arr(i, 4) <> Empty Then
         a = a + 1
           For j = 1 To 2
              arr1(a, j) = arr(i, j)
           Next j
              arr1(a, j) = dk
           For j = 4 To 7
               arr1(a, j) = arr(i, j - 1)
           Next j
       Else
          dk = arr(i, 3)
       End If
    Next i
End With
With Sheet2
      lr = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A1:G" & lr).ClearContents
      If a Then .Range("A1").Resize(a, 7).Value = arr1
End With
End Sub

 

[20cent]

Mình làm bị lỗi bạn ạ! Không biết mò VBA rồi...