Mong được giúp: để sắp xếp lại dữ liệu

20cent · 8/4/19

Mình xuất từ phần mềm bán hàng của Công ty ra 1 file excel để làm báo cáo nhưng dữ liệu sắp xếp mình không làm được báo cáo bằng Piviot Table. Mong các bạn chỉ giúp mình sắp xếp lại. Trong file đính kèm dữ liệu gốc là bảng nằm bên trái, mình muốn sắp xếp lại như bảng bên phải.

snow25 · 8/4/19

20cent đã viết:
Mình xuất từ phần mềm bán hàng của Công ty ra 1 file excel để làm báo cáo nhưng dữ liệu sắp xếp mình không làm được báo cáo bằng Piviot Table. Mong các bạn chỉ giúp mình sắp xếp lại. Trong file đính kèm dữ liệu gốc là bảng nằm bên trái, mình muốn sắp xếp lại như bảng bên phải.

Bạn chạy thử code này nhé.

Mã:

Sub chuyenduleu()
   Dim arr, arr1, ten As String, lr As Long, a As Long, i As Long, j As Long
   With Sheets("sheet2")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        If lr < 5 Then Exit Sub
        arr = .Range("A5:D" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 4)
        For i = 1 To UBound(arr, 1)
           If Len(arr(i, 3)) = 0 Then
              ten = Application.Trim(Split(arr(i, 1), ":")(1))
           Else
              a = a + 1
              arr1(a, 1) = ten
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = arr(i, 3)
              arr1(a, 4) = arr(i, 4)
           End If
        Next i
        lr = .Range("H" & Rows.Count).End(xlUp).Row
        If lr > 5 Then .Range("H6:K" & lr).ClearContents
        .Range("h6").Resize(a, 4).Value = arr1
   End With
End Sub
End Sub

tieuthubuongbinh · 8/4/19

Thêm cách dùng hàm và advanced filter.

20cent · 9/4/19

snow25 đã viết:

Bạn chạy thử code này nhé.

Mã:

Sub chuyenduleu()
   Dim arr, arr1, ten As String, lr As Long, a As Long, i As Long, j As Long
   With Sheets("sheet2")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        If lr < 5 Then Exit Sub
        arr = .Range("A5:D" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 4)
        For i = 1 To UBound(arr, 1)
           If Len(arr(i, 3)) = 0 Then
              ten = Application.Trim(Split(arr(i, 1), ":")(1))
           Else
              a = a + 1
              arr1(a, 1) = ten
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = arr(i, 3)
              arr1(a, 4) = arr(i, 4)
           End If
        Next i
        lr = .Range("H" & Rows.Count).End(xlUp).Row
        If lr > 5 Then .Range("H6:K" & lr).ClearContents
        .Range("h6").Resize(a, 4).Value = arr1
   End With
End Sub
End Sub

hi bạn, mình không biết VBA... nhìn cách này hay quá bạn có thể giúp mình ra ở Sheet khác không ạh?

snow25 · 9/4/19

20cent đã viết:
hi bạn, mình không biết VBA... nhìn cách này hay quá bạn có thể giúp mình ra ở Sheet khác không ạh?

Bạn đưa dữ liệu thực lên muốn tách sang sheets nào bạn ghi rõ ra.

20cent · 10/4/19

snow25 đã viết:
Bạn đưa dữ liệu thực lên muốn tách sang sheets nào bạn ghi rõ ra.

Chân thành cảm ơn sự nhiệt tình của bạn rất nhiều!
Dự định của mình là copy dữ liệu từ file excel (xuất từ phần mềm bán hàng của Cty) vào sheet R_data. Sau đó, mình vào sheet data click vào button (VBA code của bạn) để sắp xếp lại dữ liệu.

20cent · 10/4/19

tieuthubuongbinh đã viết:
Thêm cách dùng hàm và advanced filter.

Cảm ơn bạn. Mình cũng mới biết công thức này! Nhưng nếu data dài quá mà chạy công thức có nặng không ạ!?

snow25 · 10/4/19

20cent đã viết:
Chân thành cảm ơn sự nhiệt tình của bạn rất nhiều!
Dự định của mình là copy dữ liệu từ file excel (xuất từ phần mềm bán hàng của Cty) vào sheet R_data. Sau đó, mình vào sheet data click vào button (VBA code của bạn) để sắp xếp lại dữ liệu.

Bạn chạy sub này nhé.

Mã:

Sub chuyenduleu()
   Dim arr, arr1, ten As String, lr As Long, a As Long, i As Long, j As Long
   With Sheets("R_data")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        If lr < 5 Then Exit Sub
        arr = .Range("A5:D" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 5)
        For i = 1 To UBound(arr, 1)
           If Len(arr(i, 3)) = 0 Then
              ten = Application.Trim(Split(arr(i, 1), ":")(1))
           Else
              a = a + 1
              arr1(a, 1) = ten
              arr1(a, 2) = arr(i, 1)
              arr1(a, 3) = arr(i, 2)
              arr1(a, 4) = arr(i, 3)
              arr1(a, 5) = arr(i, 4)
           End If
        Next i
  End With
  With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("H6:K" & lr).ClearContents
        .Range("B3").Resize(a, 5).Value = arr1
   End With
End Sub

20cent · 10/4/19

mình làm vẫn bị báo lỗi... mong bạn giúp ajh!

Ba Tê · 10/4/19

20cent đã viết:
mình làm vẫn bị báo lỗi... mong bạn giúp ajh!

Dữ liệu file này khác file trước, có nhóm khách, có những dòng cuối... không phải là tên hàng hay số lượng..
Bạn xem thử file này, nếu dữ liệu không chuẩn sẽ có sai lệch kết quả.

snow25 · 10/4/19

20cent đã viết:
mình làm vẫn bị báo lỗi... mong bạn giúp ajh!

Bạn chạy thử cái này nhé.

Mã:

Sub chuyenduleu()
   Dim arr, arr1, ten As String, lr As Long, a As Long, i As Long, j As Long
   With Sheets("R_data")
        lr = .Range("A" & Rows.Count).End(xlUp).Row - 2
        If lr < 10 Then Exit Sub
        arr = .Range("A10:D" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 10)
        For i = 1 To UBound(arr, 1)
           If Len(arr(i, 3)) = 0 Then
              If InStr(1, arr(i, 1), "Khách hàng") Then
                 ten = Application.Trim(Split(arr(i, 1), ":")(1))
              End If
           Else
              a = a + 1
              arr1(a, 1) = ten
              arr1(a, 2) = arr(i, 1)
              arr1(a, 3) = arr(i, 2)
              arr1(a, 4) = arr(i, 3)
              arr1(a, 5) = arr(i, 4)
           End If
        Next i
  End With
  With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("B3:E" & lr).ClearContents
        .Range("B3").Resize(a, 5).Value = arr1
   End With
End Sub

20cent · 10/4/19

rất cảm ơn các bạn! có thể giải thích giúp mình cái code của hai bạn không ạ!

20cent · 11/4/19

snow25 đã viết:

Bạn chạy thử cái này nhé.

Mã:

Sub chuyenduleu()
   Dim arr, arr1, ten As String, lr As Long, a As Long, i As Long, j As Long
   With Sheets("R_data")
        lr = .Range("A" & Rows.Count).End(xlUp).Row - 2
        If lr < 10 Then Exit Sub
        arr = .Range("A10:D" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 10)
        For i = 1 To UBound(arr, 1)
           If Len(arr(i, 3)) = 0 Then
              If InStr(1, arr(i, 1), "Khách hàng") Then
                 ten = Application.Trim(Split(arr(i, 1), ":")(1))
              End If
           Else
              a = a + 1
              arr1(a, 1) = ten
              arr1(a, 2) = arr(i, 1)
              arr1(a, 3) = arr(i, 2)
              arr1(a, 4) = arr(i, 3)
              arr1(a, 5) = arr(i, 4)
           End If
        Next i
  End With
  With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("B3:E" & lr).ClearContents
        .Range("B3").Resize(a, 5).Value = arr1
   End With
End Sub

Mong bạn giúp mình thêm 1 file này nữa ạ! bắt đầu hiểu dần cái code này

snow25 · 11/4/19

20cent đã viết:
Mong bạn giúp mình thêm 1 file này nữa ạ! bắt đầu hiểu dần cái code này

Bạn chạy thử code này nhé.

Mã:

Sub chuyenduleu()
   Dim arr, arr1, ten As String, lr As Long, a As Long, i As Long, j As Long
   With Sheets("R_data")
        lr = .Range("A" & Rows.Count).End(xlUp).Row - 2
        If lr < 9 Then Exit Sub
        arr = .Range("A9:g" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 7)
        For i = 1 To UBound(arr, 1)
           If Len(arr(i, 3)) = 0 Then
              If arr(i, 1) = "Khách hàng:" Then
                 ten = arr(i, 2)
              End If
           Else
              If arr(i, 2) = Empty Then arr(i, 2) = arr(i - 1, 2)
              a = a + 1
              arr1(a, 1) = ten
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = arr(i, 3)
              arr1(a, 4) = arr(i, 4)
              arr1(a, 5) = arr(i, 5)
              arr1(a, 6) = arr(i, 6)
              arr1(a, 7) = arr(i, 7)
           End If
        Next i
  End With
  With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr > 4 Then .Range("B4:h" & lr).ClearContents
        .Range("B4").Resize(a, 7).Value = arr1
   End With
End Sub

20cent · 11/4/19

snow25 đã viết:

Bạn chạy thử code này nhé.

Mã:

Sub chuyenduleu()
   Dim arr, arr1, ten As String, lr As Long, a As Long, i As Long, j As Long
   With Sheets("R_data")
        lr = .Range("A" & Rows.Count).End(xlUp).Row - 2
        If lr < 9 Then Exit Sub
        arr = .Range("A9:g" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To 7)
        For i = 1 To UBound(arr, 1)
           If Len(arr(i, 3)) = 0 Then
              If arr(i, 1) = "Khách hàng:" Then
                 ten = arr(i, 2)
              End If
           Else
              If arr(i, 2) = Empty Then arr(i, 2) = arr(i - 1, 2)
              a = a + 1
              arr1(a, 1) = ten
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = arr(i, 3)
              arr1(a, 4) = arr(i, 4)
              arr1(a, 5) = arr(i, 5)
              arr1(a, 6) = arr(i, 6)
              arr1(a, 7) = arr(i, 7)
           End If
        Next i
  End With
  With Sheets("data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr > 4 Then .Range("B4:h" & lr).ClearContents
        .Range("B4").Resize(a, 7).Value = arr1
   End With
End Sub

được rồi ạ! Hay quá... cảm ơn bạn nhiều

cuoi_dat · 16/4/19

20cent đã viết:
Mình xuất từ phần mềm bán hàng của Công ty ra 1 file excel để làm báo cáo nhưng dữ liệu sắp xếp mình không làm được báo cáo bằng Piviot Table. Mong các bạn chỉ giúp mình sắp xếp lại. Trong file đính kèm dữ liệu gốc là bảng nằm bên trái, mình muốn sắp xếp lại như bảng bên phải.

Trừ khi bạn muốn học hỏi VBA, còn ko thì bạn hoàn toàn có thể thao tác qua 3 bước như sau để có được kết quả như ý:
1- đánh dấu các dòng tổng ( bằng màu hoặc ký hiệu bất kỳ), xóa các tên ADJK, AHKJ ... thành dòng trống.
2- điền dữ liệu cho các dòng trống bằng thủ thuật copy từ trên xuống (sử dụng goto blank)
3- xóa các dòng tổng vừa đánh dấu.
Qua 3 bước kia bạn sẽ có kết quả mong muốn, thiết nghĩ như vậy sẽ nhanh, trực quan và đơn giản hơn.

20cent · 3/5/20

Mong được bạn giúp đỡ sắp xếp dữ liệu file này được không ạ!?

Mong được giúp: để sắp xếp lại dữ liệu

Thành viên mới

File đính kèm

Thành viên gạo cội

File đính kèm

Học hoài vẫn dốt

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Facebook

Group