Xử lý dữ liệu theo điều kiện

Liên hệ QC

vanvan9697

Thành viên chính thức
Tham gia
11/5/12
Bài viết
94
Được thích
5
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ả ạ
Mã:
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
 

File đính kèm

  • Xử lý dữ liệu.xlsx
    15.2 KB · Đọc: 19
"Lấy đồng nhất" là lấy NTN?
 
"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 ạ
 
Cái này thấy xử lý bằng tay cũng nhanh mà nhỉ !
 
Anh ( chị ) giúp em đoạn sub này với ạ !
 
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ả ạ
Mã:
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é.
Mã:
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
 
Bạn dùng code này xem nhé.
Mã:
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 ạ
 

File đính kèm

  • Xử lý dữ liệu.xlsx
    14.1 KB · Đọc: 13
Lần chỉnh sửa cuối:
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 ạ
 
Anh (chị) xem giúp em vấn đề này với ạ
Bạn dùng code này xem.
Mã:
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
 
Mình làm bị lỗi bạn ạ! Không biết mò VBA rồi...
 

File đính kèm

  • (RAW) Bao cao tong hop hang ban cho khach.xlsm
    23.9 KB · Đọc: 2
Web KT
Back
Top Bottom