Sắp xếp dữ liệu (2 người xem)

[YouthGoneWild]

Các bác làm ơn giúp em sắp xếp dữ liệu trong file đính kèm với! Ở cột A: Cách dòng trống là 1 sản phẩm. Dòng đầu tiên là Mã hàng (chỉ lấy từ đầu tiên). Dòng tiếp theo là Tên hàng (cái này có thể có hoặc là trống không). Ở cột B: Số lượng. Mình phải sắp xếp dữ liệu sao cho: - Ở cột D: Mã hàng - Ở cột E: Tên hàng - Ở cột F: Số lượng (Giống như các hàng được bôi màu vàng trong file ạ) Em cảm ơn các bác trước ạ!

 

[dat_butmuc]

Các bác làm ơn giúp em sắp xếp dữ liệu trong file đính kèm với! Ở cột A: Cách dòng trống là 1 sản phẩm. Dòng đầu tiên là Mã hàng (chỉ lấy từ đầu tiên). Dòng tiếp theo là Tên hàng (cái này có thể có hoặc là trống không). Ở cột B: Số lượng. Mình phải sắp xếp dữ liệu sao cho: - Ở cột D: Mã hàng - Ở cột E: Tên hàng - Ở cột F: Số lượng (Giống như các hàng được bôi màu vàng trong file ạ) Em cảm ơn các bác trước ạ!

Tôi nghĩ file bạn cần trong file đính kèm
Còn bạn muốn đẹp hơn nữa thì chỉ cần delete xóa các dòng không có dữ liệu,
Thân,

 

[YouthGoneWild]

Tôi nghĩ file bạn cần trong file đính kèm
Còn bạn muốn đẹp hơn nữa thì chỉ cần delete xóa các dòng không có dữ liệu,
Thân,

Cảm ơn bác đã giúp đỡ. Em hỏi 1 cái nữa là nếu viết trong VBA thì viết như thế nào ạ? Vì em không biết dùng vòng lặp sao để ra kết quả.

 

[dat_butmuc]

Cảm ơn bác đã giúp đỡ. Em hỏi 1 cái nữa là nếu viết trong VBA thì viết như thế nào ạ? Vì em không biết dùng vòng lặp sao để ra kết quả.

Bạn muốn viết cho file ở dưới phải không?
Còn nếu hỏi về lập trình thì ta chuyển sang bên phần lập trình, sẽ có nhiều cao thủ giúp đỡ.

 

[YouthGoneWild]

Đúng ạ, em muốn lập trình cho file đính kèm ở bài đầu tiên ạ! =)

 

[SA_DQ]

Thì đây, xin mời tham khảo

Cảm ơn bác đã giúp đỡ. Em hỏi 1 cái nữa là nếu viết trong VBA thì viết như thế nào ạ? Vì em không biết dùng vòng lặp sao để ra kết quả.

Option Explicit
Sub CopyForRow()
 Dim Clls As Range
 Columns("D:E").Clear
 For Each Clls In Range([A1], [A65500].End(xlUp))
   If IsNumeric(Left(Clls.Value, 4)) Then
      Clls.Offset(, 3).Value = Left(Clls.Value, 4)
      Clls.Offset(, 4).Value = WorksheetFunction.Trim(Clls.Offset(1).Value)
   End If
 Next Clls
End Sub

 

[YouthGoneWild]

Option Explicit
Sub CopyForRow()
 Dim Clls As Range
 Columns("D:E").Clear
 For Each Clls In Range([A1], [A65500].End(xlUp))
   If IsNumeric(Left(Clls.Value, 4)) Then
      Clls.Offset(, 3).Value = Left(Clls.Value, 4)
      Clls.Offset(, 4).Value = WorksheetFunction.Trim(Clls.Offset(1).Value)
   End If
 Next Clls
End Sub

Cảm ơn bác. Nhưng Mã hàng không phải lúc nào cũng có 4 ký tự đâu ạ, và cũng không phải lúc nào cũng là số. Như em đã nói ở trên, Mã hàng là từ đầu tiên. Bác có thể sửa code giúp em được không ạ?

 

[SA_DQ]

Vậy thì căn cứ vô sản lượng vậy

Option Explicit
Sub CopyForRow()
 Dim Clls As Range, VTr As Byte:       Const CT As String = " "
 Columns("D:F").Clear
 For Each Clls In Range([B1], [B65500].End(xlUp))
   With Clls.Offset(, -1)
      If Clls.Value <> "" Then
         VTr = InStr(.Value & CT, CT)
         .Offset(, 3).Value = Left(.Value, VTr - 1)
         .Offset(, 4).Value = WorksheetFunction.Trim(.Offset(1).Value)
         .Offset(, 5).Value = Clls.Value
      End If
   End With
 Next Clls
End Sub

 

[YouthGoneWild]

Option Explicit
Sub CopyForRow()
 Dim Clls As Range, VTr As Byte:       Const CT As String = " "
 Columns("D:F").Clear
 For Each Clls In Range([B1], [B65500].End(xlUp))
   With Clls.Offset(, -1)
      If Clls.Value <> "" Then
         VTr = InStr(.Value & CT, CT)
         .Offset(, 3).Value = Left(.Value, VTr - 1)
         .Offset(, 4).Value = WorksheetFunction.Trim(.Offset(1).Value)
         .Offset(, 5).Value = Clls.Value
      End If
   End With
 Next Clls
End Sub

Sản lượng nhiều khi cũng bị bỏ trống bác ạ.

 

[dat_butmuc]

Sản lượng nhiều khi cũng bị bỏ trống bác ạ.

Tôi thấy bài của HYen17 làm cũng rất tốt rồi với lại dữ liệu của bạn không lớn và phức tạp lắm. Cái nào dùng được nhanh, dễ hiểu thì cứ làm thôi bạn ạ.
Đồng nhất dữ liệu một lần rồi yêu cầu luôn là mọi người giúp nhanh thôi !
Thân,

 

[ChanhTQ@]

Vẫn phải dùng bẫy lỗi để cho qua phà!

Option Explicit
Sub CopyTo()
 On Error GoTo Loi:           Dim Mot As Boolean
 Dim Rng As Range, lRng As Range
 
 Set Rng = [A1]:           Columns("D:F").Clear
 Do
   Set lRng = Rng.End(xlDown)
   If lRng.Row > 65500 Then Exit Do
   
1   If Rng.Row = lRng.Row - 1 Then
      Cells(Rng.Row, "D").Value = Left(Rng.Value, 4)
      Cells(Rng.Row, "F").Value = Rng.Offset(, 1).Value
      Cells(Rng.Row, "E").Value = WorksheetFunction.Trim(lRng.Value)
      Mot = True
   Else   '*'
      Cells(Rng.Row, "D").Value = Left(Rng.Value, 4)
      Cells(Rng.Row, "F").Value = Rng.Offset(, 1).Value
2     If Rng.Row > lRng - 1 Then _
         Rng.Offset(, 5).Interior.ColorIndex = 38
3   End If
4   If Mot Then
      Set Rng = lRng.End(xlDown):                     Mot = Not Mot
   Else
      Set Rng = lRng
   End If
 Loop
Err:           Exit Sub
Loi:
   If Rng.Interior.ColorIndex < 35 Then _
      Rng.Offset(, 4).Interior.ColorIndex = 35
   Resume Next
End Sub