CHUYỂN BÁO CÁO VỀ LẠI DỮ LIỆU (1 người xem)

hoangyen69 · 4/6/18

Hiện mình đang cần chuyển từ báo cáo về lại dữ liệu nhưng không biết làm, các bạn chỉ giúp mình, cảm ơn ! Mình gửi file đính kèm

be_09 · 10/6/18

hoangyen69 đã viết:
Cảm ơn bạn đã góp ý cho mình. Như tiêu đề thì file excel của mình gồm sheet 1 là báo cáo. Số cột 700 và có khả năng lên 1000 cột, số dòng là 500, mình cần chuyển sheet 1 về dạng dữ liệu như sheet 2. Nghĩa là 700 cột sẽ nhân cho 500 dòng thành 350.000 dòng đó bạn. Mục đích là mình cần filter cho dễ và có thể tận dụng để làm các báo cáo khác. Cảm ơn !

Xin thưa với bạn là tôi đã thiết kế lại còn có 10 nhập liệu theo chiều dọc (chứ không làm như bạn là 700 hay 100 cột) bây giờ bạn muốn theo dõi 10.000 đơn hàng cũng được, cỡ 350.000 dòng mà muốn báo cáo như của bạn thì dùng PivotTable chỉ mất vài phút.

Với cấu trúc File này bạn có thể sử dụng thêm nhiều chức năng khác như:
1/ Xuất mỗi đơn hàng 1 sheet.
2/ Xuất mỗi người đặt hàng là 1 sheet.
3/ Xuất mỗi tỉnh 1 sheet.

Và có thể tổng hợp mỗi tỉnh có bao nhiêu người đặt hàng, người nào ở tỉnh nào đặt loại hàng nào nhiều nhất hoặc người nào đặt hàng của mình nhiều nhất.

hoangyen69 · 10/6/18

be09 đã viết:
Xin thưa với bạn là tôi đã thiết kế lại còn có 10 nhập liệu theo chiều dọc (chứ không làm như bạn là 700 hay 100 cột) bây giờ bạn muốn theo dõi 10.000 đơn hàng cũng được, cỡ 350.000 dòng mà muốn báo cáo như của bạn thì dùng PivotTable chỉ mất vài phút.

Với cấu trúc File này bạn có thể sử dụng thêm nhiều chức năng khác như:
1/ Xuất mỗi đơn hàng 1 sheet.
2/ Xuất mỗi người đặt hàng là 1 sheet.
3/ Xuất mỗi tỉnh 1 sheet.

Và có thể tổng hợp mỗi tỉnh có bao nhiêu người đặt hàng, người nào ở tỉnh nào đặt loại hàng nào nhiều nhất hoặc người nào đặt hàng của mình nhiều nhất.

Bạn be09 vẫn không hiểu ý mình muốn, mình không phải là người nhập liệu, nên cơ bản mình không có sheet dữ liệu, mình đã nói là mình chỉ có cái sheet báo cáo 700 cột 500 dòng thôi. Mình đang lấy cái báo cáo của người khác để làm thành dữ liệu. Vì người khác không cho dữ liệu nên mình phải làm ngược lại thôi. Vậy đó =.='

be_09 · 10/6/18

hoangyen69 đã viết:
Bạn be09 vẫn không hiểu ý mình muốn, mình không phải là người nhập liệu, nên cơ bản mình không có sheet dữ liệu, mình đã nói là mình chỉ có cái sheet báo cáo 700 cột 500 dòng thôi. Mình đang lấy cái báo cáo của người khác để làm thành dữ liệu. Vì người khác không cho dữ liệu nên mình phải làm ngược lại thôi. Vậy đó =.='

Nếu người khác nhập liệu và cùng Công ty hay đơn vị thì bạn nên góp ý cho người nhập liệu như tôi thiết kế để người ta nhập liệu cho dễ dàng mà đỡ sai sót, sau này cần báo cáo cái gì bạn chỉ cần nhấn nút vèo cái là xong, chứ cấu trúc như kiểu File của bạn tôi không chơi.

Ba cái vụ này trước đây tôi cũng bị hoài, 11 huyện mỗi huyện báo cáo 1 kiểu, 13 phòng trực thuộc mỗi phòng làm báo cáo 1 kiểu, riêng 20 anh em trong phòng, mỗi người theo dõi kế hoạch 1 kiểu, mỗi khi làm báo cáo phải gôm một mớ hổn độn đó vô rồi xử lý mới có được 1 cái báo cáo. Chưa kể ba cái vụ anh em nó ghi tên 171 xã, mỗi tên xã là 1 kiểu (xã TT, xTT, xã T Thu, x Thiên Thu, lúc có chấm, lúc không chấm, lúc lại phẩy, lúc lại có khoảng trắng) ôi thôi thì hầm bà lằng.

♫ђöล♥ßล†♥†µ♫ · 10/6/18

hoangyen69 đã viết:
Cảm ơn bạn, nhờ bạn coi lại dùm mình từ dòng số 119402 bị dư ra rồi bạn

Mình chỉnh lại 1 tí tị tì ti trong Code của thầy @giaiphap. Bạn xem thử

PHP:

Sub GPE()
On Error Resume Next
    Dim Arr(), dArr()
    Dim i As Long, j As Long, k As Long, Col As Long
With Sheet1
    Col = .Range("B1").End(xlToRight).Column
    Arr = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, Col).Value
End With
ReDim dArr(1 To UBound(Arr, 1) * UBound(Arr, 2), 1 To 3)
For j = 2 To UBound(Arr, 2)
    For i = 2 To UBound(Arr, 1)
        If Arr(i, j) <> Empty Then
            k = k + 1
            dArr(k, 1) = Arr(1, j)
            dArr(k, 2) = Arr(i, 1)
            dArr(k, 3) = Arr(i, j)
        End If
    Next i
Next j
With Sheet3
    .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp)).ClearContents
    .Range("A2").Resize(k, 3) = dArr
End With
End Sub

SA_DQ · 10/6/18

hoangyen69 đã viết:
Cảm ơn bạn, nhờ bạn coi lại dùm mình từ dòng số 119402 bị dư ra rồi bạn

Bạn thay dòng lệnh này vô macro đó & chạy lại xem sao"

PHP:

   Arr = Sheet1.Range("A1").CurrentRegion.Value

Khi giả lập file lại theo macro sau, sẽ dễ kiểm tra hơn:

Mã:

Sub ThaySoLieu()
 Dim Cot As Integer, Dong As Long, J As Long, W As Integer
 With Sheet1
    Dong = .[B1].CurrentRegion.Rows.Count - 1
    Cot = .[B1].CurrentRegion.Columns.Count
 End With
 For W = 2 To Cot
    Cells(2, W).Resize(Dong) = W
 Next W
End Sub

giaiphap · 10/6/18

hoangyen69 đã viết:
Cảm ơn bạn, nhờ bạn coi lại dùm mình từ dòng số 119402 bị dư ra rồi bạn

Vậy sửa thế này.

Mã:

Sub GPE()
On Error Resume Next
Dim i As Long, j As Long, k As Long, Arr(), dArr()
Arr = Sheet1.Range("A1:" & Cells(Sheet1.Range("A65000").End(xlUp).Row, Sheet1.Range("XFD1").End(xlToLeft).Column).Address).Value
ReDim dArr(1 To UBound(Arr, 1) * UBound(Arr, 2), 1 To 3)
For j = 2 To UBound(Arr, 2)
      For i = 2 To UBound(Arr, 1)
            k = k + 1
            dArr(k, 1) = Arr(1, j)
            dArr(k, 2) = Arr(i, 1)
            dArr(k, 3) = Arr(i, j)
      Next i
Next j
Sheet3.Range("A2:C" & Sheet3.Range("A65000").End(xlUp).Row).ClearContents
Sheet3.Range("A2").Resize(k, 3) = dArr
End Sub

hoangyen69 · 10/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:

Mình chỉnh lại 1 tí tị tì ti trong Code của thầy @giaiphap. Bạn xem thử

PHP:

Sub GPE()
On Error Resume Next
    Dim Arr(), dArr()
    Dim i As Long, j As Long, k As Long, Col As Long
With Sheet1
    Col = .Range("B1").End(xlToRight).Column
    Arr = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, Col).Value
End With
ReDim dArr(1 To UBound(Arr, 1) * UBound(Arr, 2), 1 To 3)
For j = 2 To UBound(Arr, 2)
    For i = 2 To UBound(Arr, 1)
        If Arr(i, j) <> Empty Then
            k = k + 1
            dArr(k, 1) = Arr(1, j)
            dArr(k, 2) = Arr(i, 1)
            dArr(k, 3) = Arr(i, j)
        End If
    Next i
Next j
With Sheet3
    .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp)).ClearContents
    .Range("A2").Resize(k, 3) = dArr
End With
End Sub

Cảm ơn bạn !

Bài đã được tự động gộp: 10/6/18

giaiphap đã viết:

Vậy sửa thế này.

Mã:

Sub GPE()
On Error Resume Next
Dim i As Long, j As Long, k As Long, Arr(), dArr()
Arr = Sheet1.Range("A1:" & Cells(Sheet1.Range("A65000").End(xlUp).Row, Sheet1.Range("XFD1").End(xlToLeft).Column).Address).Value
ReDim dArr(1 To UBound(Arr, 1) * UBound(Arr, 2), 1 To 3)
For j = 2 To UBound(Arr, 2)
      For i = 2 To UBound(Arr, 1)
            k = k + 1
            dArr(k, 1) = Arr(1, j)
            dArr(k, 2) = Arr(i, 1)
            dArr(k, 3) = Arr(i, j)
      Next i
Next j
Sheet3.Range("A2:C" & Sheet3.Range("A65000").End(xlUp).Row).ClearContents
Sheet3.Range("A2").Resize(k, 3) = dArr
End Sub

Cảm ơn bạn nhiều !

hoangyen69 · 14/6/18

giaiphap đã viết:

Vậy sửa thế này.

Mã:

Sub GPE()
On Error Resume Next
Dim i As Long, j As Long, k As Long, Arr(), dArr()
Arr = Sheet1.Range("A1:" & Cells(Sheet1.Range("A65000").End(xlUp).Row, Sheet1.Range("XFD1").End(xlToLeft).Column).Address).Value
ReDim dArr(1 To UBound(Arr, 1) * UBound(Arr, 2), 1 To 3)
For j = 2 To UBound(Arr, 2)
      For i = 2 To UBound(Arr, 1)
            k = k + 1
            dArr(k, 1) = Arr(1, j)
            dArr(k, 2) = Arr(i, 1)
            dArr(k, 3) = Arr(i, j)
      Next i
Next j
Sheet3.Range("A2:C" & Sheet3.Range("A65000").End(xlUp).Row).ClearContents
Sheet3.Range("A2").Resize(k, 3) = dArr
End Sub

Bạn ơi, bạn cho mình hỏi thêm, nếu trường hợp cột DH nó trùng 2 lần thì mình làm sao từ sheet 1 chuyển về được như sheet 2. Mình gửi file đính kèm, nhờ bạn xem giúp. Cảm ơn bạn !

♫ђöล♥ßล†♥†µ♫ · 14/6/18

hoangyen69 đã viết:
Bạn ơi, bạn cho mình hỏi thêm, nếu trường hợp cột DH nó trùng 2 lần thì mình làm sao từ sheet 1 chuyển về được như sheet 2. Mình gửi file đính kèm, nhờ bạn xem giúp. Cảm ơn bạn !

Bạn thử cái này xem sao

PHP:

Sub GPE1()
    Dim R1 As Long, R2 As Long, Col As Long, sRng As Range, Rng As Range, J As Long, I As Long
    R1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    R2 = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    Col = Sheet1.Range("A1").End(xlToRight).Column
    Set sRng = Sheet1.Range("A2:A" & R1)
    I = 2
    If R2 > 2 Then Sheet2.Range("A2:A" & R2).Resize(, 4).ClearContents
    For J = 4 To Col Step 2
        Sheet2.Range("A" & I).Resize(R1 - 1) = Sheet1.Cells(1, J)
        sRng.Copy Sheet2.Range("B" & I)
        Sheet1.Range(Sheet1.Cells(2, J), Sheet1.Cells(R1, J + 1)).Copy Sheet2.Range("C" & I)
        I = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Next J
End Sub

hoangyen69 · 14/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:

Bạn thử cái này xem sao

PHP:

Sub GPE()
On Error Resume Next
Dim i As Long, j As Long, k As Long, Arr(), dArr()
Arr = Sheet1.Range("A1:" & Cells(Sheet1.Range("A65000").End(xlUp).Row, Sheet1.Range("XFD1").End(xlToLeft).Column).Address).Value
ReDim dArr(1 To UBound(Arr, 1) * UBound(Arr, 2), 1 To 3)
For j = 2 To UBound(Arr, 2)
      For i = 2 To UBound(Arr, 1)
            k = k + 1
            dArr(k, 1) = Arr(1, j)
            dArr(k, 2) = Arr(i, 1)
            dArr(k, 3) = Arr(i, j)
      Next i
Next j
Sheet3.Range("A2:C" & Sheet3.Range("A65000").End(xlUp).Row).ClearContents
Sheet3.Range("A2").Resize(k, 3) = dArr
End Sub

Cảm ơn bạn, mình đã làm được rồi ! Bạn cho mình hỏi thêm là trường hợp code của thầy giaiphap thì mình làm tiếp như thế nào để được kết quả giống vầy vậy bạn ?

CHUYỂN BÁO CÁO VỀ LẠI DỮ LIỆU (1 người xem)

Người dùng đang xem chủ đề này

hoangyen69

Thành viên chính thức

File đính kèm

be_09

Biên Hòa, Đồng Nai

File đính kèm

hoangyen69

Thành viên chính thức

be_09

Biên Hòa, Đồng Nai

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu

SA_DQ

/(hông là gì!

giaiphap

==(^o^)==

hoangyen69

Thành viên chính thức

hoangyen69

Thành viên chính thức

File đính kèm

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu

hoangyen69

Thành viên chính thức

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian