THỰC HIỆN LỌC DỮ LIỆU 2 CHIỀU

Liên hệ QC
H

hoahuongduong1986

Thành viên thường trực
Tham gia
14/11/18
Bài viết
346
Được thích
40
Kính gửi anh chị
Nếu làm kết quả như tại sheet Pivot thì khá đơn giản và Pivot hỗ trợ mạnh. Còn nếu làm bằng code thì thế nào ạ ?
 

File đính kèm

  • Code thuc hien Pivot.xlsm
    2.2 MB · Đọc: 32
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Cái này nếu nó tăng hơn 2 năm 2013, 2014 thì sao bạn? Ví dụ 2013, 2014, 2015, ...., 2021 hay chỉ thực hiện trong 2 năm?
 
Upvote 0
hoahuongduong1986 đã viết:
Chỉ 2 năm thôi ạ, lấy năm lớn trừ năm bé thôi ạ.
Nhấp chuột vào đây để mở rộng...
Vậy thì dễ thôi, code thế này:

Mã: 
Sub PhanTichDuLieu()
    Dim objDict As Object
    Dim arrData, arrResult
    Dim shtData As Worksheet
    Dim e As Long, m As Long, n As Long, r As Long, u As Long
    Set objDict = CreateObject("scripting.dictionary")
    Set shtData = Worksheets("Data")
    e = shtData.Range("F" & shtData.Rows.Count).End(xlUp).Row
    arrData = shtData.Range("B2:J" & e).Value
    u = UBound(arrData)
    ReDim arrResult(1 To u, 1 To 5)
    For r = 1 To u
        If objDict.Exists(arrData(r, 5)) Then
            m = objDict.Item(arrData(r, 5))
            If arrData(r, 1) = 2013 Then
                arrResult(m, 2) = arrResult(m, 2) + arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(m, 3) = arrResult(m, 3) + arrData(r, 9)
            End If
            arrResult(m, 4) = arrResult(m, 3) - arrResult(m, 2)
            If arrResult(m, 2) <> 0 Then
                arrResult(m, 5) = arrResult(m, 4) / arrResult(m, 2)
            End If
        Else
            n = n + 1
            objDict(arrData(r, 5)) = n
            arrResult(n, 1) = arrData(r, 5)
            If arrData(r, 1) = 2013 Then
                arrResult(n, 2) = arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(n, 3) = arrData(r, 9)
            End If
            arrResult(n, 4) = arrResult(n, 3) - arrResult(n, 2)
            If arrResult(n, 2) <> 0 Then
                arrResult(n, 5) = arrResult(n, 4) / arrResult(n, 2)
            End If
        End If
    Next
    Worksheets("Pivot").Range("G4:K4").Value = Array("Reporter ISO", "2013", "2014", "T" & ChrW(259) & "ng gi" & ChrW(7843) & "m", _
                                               "Bi" & ChrW(7871) & "n " & ChrW(273) & ChrW(7897) & "ng")
    Worksheets("Pivot").Range("G5:K5").Resize(n).Value = arrResult
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Vậy thì dễ thôi, code thế này:

Mã: 
Sub PhanTichDuLieu()
    Dim c As Byte
    Dim objDict As Object
    Dim arrData, arrResult
    Dim shtData As Worksheet
    Dim e As Long, m As Long, n As Long, r As Long, u As Long
    Set objDict = CreateObject("scripting.dictionary")
    Set shtData = Worksheets("Data")
    e = shtData.Range("F" & shtData.Rows.Count).End(xlUp).Row
    arrData = shtData.Range("B2:J" & e).Value
    u = UBound(arrData)
    ReDim arrResult(1 To u, 1 To 5)
    For r = 1 To u
        If objDict.Exists(arrData(r, 5)) Then
            m = objDict.Item(arrData(r, 5))
            If arrData(r, 1) = 2013 Then
                arrResult(m, 2) = arrResult(m, 2) + arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(m, 3) = arrResult(m, 3) + arrData(r, 9)
            End If
            arrResult(m, 4) = arrResult(m, 3) - arrResult(m, 2)
            If arrResult(m, 2) <> 0 Then
                arrResult(m, 5) = arrResult(m, 4) / arrResult(m, 2)
            End If
        Else
            n = n + 1
            objDict(arrData(r, 5)) = n
            arrResult(n, 1) = arrData(r, 5)
            If arrData(r, 1) = 2013 Then
                arrResult(n, 2) = arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(n, 3) = arrData(r, 9)
            End If
            arrResult(n, 4) = arrResult(n, 3) - arrResult(n, 2)
            If arrResult(n, 2) <> 0 Then
                arrResult(n, 5) = arrResult(n, 4) / arrResult(n, 2)
            End If
        End If
    Next
    Worksheets("Pivot").Range("G4:K4").Value = Array("Reporter ISO", "2013", "2014", "T" & ChrW(259) & "ng gi" & ChrW(7843) & "m", _
                                               "Bi" & ChrW(7871) & "n " & ChrW(273) & ChrW(7897) & "ng")
    Worksheets("Pivot").Range("G5:K5").Resize(n).Value = arrResult
End Sub
Nhấp chuột vào đây để mở rộng...
Hay quá, em cảm ơn anh nhiều ạ !
 
Upvote 0
hoahuongduong1986 đã viết:
Nếu làm kết quả như tại sheet Pivot thì khá đơn giản và Pivot hỗ trợ mạnh. Còn nếu làm bằng code thì thế nào ạ ?
Nhấp chuột vào đây để mở rộng...
Bạn thử code này coi.
Mã: 
Sub ABC()
    Dim Arr(), Res, i As Long, iR&, Dic As Object, K&
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Data")
    iR = .Range("A" & Rows.Count).End(xlUp).Row
    Arr = .Range("A2:J" & iR).Value
    ReDim Res(1 To UBound(Arr), 1 To 5)
    For i = 1 To UBound(Arr)
        If Dic.Exists(Arr(i, 6)) = False Then
            K = K + 1
            Dic.Add Arr(i, 6), K
            Res(K, 1) = Arr(i, 6)
            If Arr(i, 2) = 2013 Then Res(K, 2) = Arr(i, 10)
            If Arr(i, 2) = 2014 Then Res(K, 3) = Arr(i, 10)
        Else
            If Arr(i, 2) = 2013 Then Res(Dic.Item(Arr(i, 6)), 2) = Res(Dic.Item(Arr(i, 6)), 2) + Arr(i, 10)
            If Arr(i, 2) = 2014 Then Res(Dic.Item(Arr(i, 6)), 3) = Res(Dic.Item(Arr(i, 6)), 3) + Arr(i, 10)
        End If
    Next i
    For i = 1 To K
        Res(i, 4) = Res(i, 3) - Res(i, 2)
        If Res(i, 2) <> Empty Then
            Res(i, 5) = Res(i, 4) / Res(i, 2)
        End If
    Next
End With
With Sheets("Pivot")
    .Range("H5:L1000").ClearContents
    .Range("H5:L5").Resize(K).Value = Res
    .Range("H5:L5").Resize(K).Sort .Range("H4"), xlAscending
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Chưa hiểu sao bạn phải khổ thế, nếu Pivot Table xử lý được thì nên dùng Pivot, có thể làm code để refresh được.
Code này phải tự thêm tiêu đề bằng tay, không tự động được như của anh @Hoàng Trọng Nghĩa
Mã: 
Sub TongHop()
'On Error Resume Next
Dim i&, k&, Dic As Object, Data(), KQ(), Itm
Data = Sheets("Data").Range("A2", Sheets("Data").Range("J" & Rows.Count).End(3)).Value
ReDim KQ(1 To UBound(Data), 1 To 5)
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
For i = 1 To UBound(Data)
    Itm = Data(i, 6)
    If Not Dic.Exists(Itm) Then
        k = k + 1
        Dic.Add Itm, k
        KQ(k, 1) = Data(i, 6)
        If Data(i, 2) = 2013 Then
            KQ(k, 2) = Data(i, 10)
        Else
            KQ(k, 3) = Data(i, 10)
        End If
    Else
        If Data(i, 2) = 2013 Then
            KQ(Dic.Item(Itm), 2) = KQ(Dic.Item(Itm), 2) + Data(i, 10)
        Else
            KQ(Dic.Item(Itm), 3) = KQ(Dic.Item(Itm), 3) + Data(i, 10)
        End If
    End If
Next
For i = 1 To k
    KQ(i, 4) = KQ(i, 3) - KQ(i, 2)
    If KQ(i, 2) <> 0 Then KQ(i, 5) = KQ(i, 4) / KQ(i, 2)
Next
Sheets("Pivot").[H5].Resize(k, 5) = KQ
End Sub
 
Upvote 0
hoahuongduong1986 đã viết:
Kính gửi anh chị
Nếu làm kết quả như tại sheet Pivot thì khá đơn giản và Pivot hỗ trợ mạnh. Còn nếu làm bằng code thì thế nào ạ ?
Nhấp chuột vào đây để mở rộng...
Thêm cho bạn một cách nhé:
Mã: 
Sub Gop_HLMT()
    Dim str2013 As String, str2014 As String, i As Integer
    str2013 = "IIf([Year]=2013,[Trade Value (US$)],0)"
    str2014 = "IIf([Year]=2014,[Trade Value (US$)],0)"
    With CreateObject("ADODB.Recordset")
        .Open "SELECT [Reporter ISO], sum(" & str2013 & ") as [2013],sum(" & str2014 & ") as [2014],sum(" & str2014 & ")-sum(" & str2013 & ") as [Tang Giam],(sum(" & str2014 & ")-sum(" & str2013 & "))/sum(" & str2013 & ") as [Bien Dong] FROM [Data$] Where [Trade Value (US$)]>0 Group By [Reporter ISO]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet1.Range("G5").CopyFromRecordset .DataSource
        For i = 0 To .Fields.Count - 1
            Sheet1.Cells(4, i + 7) = .Fields(i).Name
        Next
    End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Thêm cho bạn một cách nhé:
Mã: 
Sub Gop_HLMT()
    Dim strValue As String, str2013 As String, str2014 As String, i As Integer
    str2013 = "IIf([Year]=2013,[Trade Value (US$)],0)"
    str2014 = "IIf([Year]=2014,[Trade Value (US$)],0)"
    With CreateObject("ADODB.Recordset")
        .Open "SELECT [Reporter ISO], sum(" & str2013 & ") as [2013],sum(" & str2014 & ") as [2014],sum(" & str2014 & ")-sum(" & str2013 & ") as [Tang Giam],(sum(" & str2014 & ")-sum(" & str2013 & "))/sum(" & str2013 & ") as [Bien Dong] FROM [Data$] Where [Trade Value (US$)]>0 Group By [Reporter ISO]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet1.Range("G5").CopyFromRecordset .DataSource
        For i = 0 To .Fields.Count - 1
            Sheet1.Cells(4, i + 7) = .Fields(i).Name
        Next
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Có cách nào học về cái ADO này nhanh không thầy? Thấy thầy dùng cái này ngắn gọn quá. mà chẳng hiểu gì ạ
 
Upvote 0
Upvote 0
Upvote 0
Cá ngừ F1 đã viết:
Hi anh, có tool nào như kiểu addin trên excel để soạn các câu lệnh SQL xong ra kết quả câu lệnh không anh?
Nhấp chuột vào đây để mở rộng...
Bạn xài thử cái này xem sao:
analystcave.com

Excel SQL AddIn - Create SQL queries in Excel (MS Query)

The Excel SQL AddIn allows you to easily execute SQL queries from Excel based on data in Excel, Access and SQL databases. Excel SQL is easy!
analystcave.com analystcave.com
1632473062228.png
Tôi chưa dùng A Tool, hình như A Tool cũng kết nối SQL thì phải.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Thêm cho bạn một cách nhé:
Mã: 
Sub Gop_HLMT()
    Dim strValue As String, str2013 As String, str2014 As String, i As Integer
    str2013 = "IIf([Year]=2013,[Trade Value (US$)],0)"
    str2014 = "IIf([Year]=2014,[Trade Value (US$)],0)"
    With CreateObject("ADODB.Recordset")
        .Open "SELECT [Reporter ISO], sum(" & str2013 & ") as [2013],sum(" & str2014 & ") as [2014],sum(" & str2014 & ")-sum(" & str2013 & ") as [Tang Giam],(sum(" & str2014 & ")-sum(" & str2013 & "))/sum(" & str2013 & ") as [Bien Dong] FROM [Data$] Where [Trade Value (US$)]>0 Group By [Reporter ISO]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet1.Range("G5").CopyFromRecordset .DataSource
        For i = 0 To .Fields.Count - 1
            Sheet1.Cells(4, i + 7) = .Fields(i).Name
        Next
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm
Hai Lúa Miền Tây đã viết:
Thêm cho bạn một cách nhé:
Mã: 
Sub Gop_HLMT()
    Dim strValue As String, str2013 As String, str2014 As String, i As Integer
    str2013 = "IIf([Year]=2013,[Trade Value (US$)],0)"
    str2014 = "IIf([Year]=2014,[Trade Value (US$)],0)"
    With CreateObject("ADODB.Recordset")
        .Open "SELECT [Reporter ISO], sum(" & str2013 & ") as [2013],sum(" & str2014 & ") as [2014],sum(" & str2014 & ")-sum(" & str2013 & ") as [Tang Giam],(sum(" & str2014 & ")-sum(" & str2013 & "))/sum(" & str2013 & ") as [Bien Dong] FROM [Data$] Where [Trade Value (US$)]>0 Group By [Reporter ISO]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet1.Range("G5").CopyFromRecordset .DataSource
        For i = 0 To .Fields.Count - 1
            Sheet1.Cells(4, i + 7) = .Fields(i).Name
        Next
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Hai Lúa Miền Tây đã viết:
Thêm cho bạn một cách nhé:
Mã: 
Sub Gop_HLMT()
    Dim strValue As String, str2013 As String, str2014 As String, i As Integer
    str2013 = "IIf([Year]=2013,[Trade Value (US$)],0)"
    str2014 = "IIf([Year]=2014,[Trade Value (US$)],0)"
    With CreateObject("ADODB.Recordset")
        .Open "SELECT [Reporter ISO], sum(" & str2013 & ") as [2013],sum(" & str2014 & ") as [2014],sum(" & str2014 & ")-sum(" & str2013 & ") as [Tang Giam],(sum(" & str2014 & ")-sum(" & str2013 & "))/sum(" & str2013 & ") as [Bien Dong] FROM [Data$] Where [Trade Value (US$)]>0 Group By [Reporter ISO]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet1.Range("G5").CopyFromRecordset .DataSource
        For i = 0 To .Fields.Count - 1
            Sheet1.Cells(4, i + 7) = .Fields(i).Name
        Next
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Code hay quá, cảm ơn anh và các anh đã trợ giúp các cách hay ạ !
 
Upvote 0
tranhungdao12a3 đã viết:
Bạn xài thử cái này xem sao:
analystcave.com

Excel SQL AddIn - Create SQL queries in Excel (MS Query)

The Excel SQL AddIn allows you to easily execute SQL queries from Excel based on data in Excel, Access and SQL databases. Excel SQL is easy!
analystcave.com analystcave.com
View attachment 266606
Tôi chưa dùng A Tool, hình như A Tool cũng kết nối SQL thì phải.
Nhấp chuột vào đây để mở rộng...
Chào bạn, tôi vừa có addin, thử với lệnh SQL này lại báo lỗi, để đếm bỏ trùng các Partner, tôi bỏ Count đi thì ra kết quả loại trùng (vùng khoanh đỏ trên hình), mà đưa lệnh count vào để đếm lại báo lỗi syntax.

Snag_205078ee.png
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Vậy thì dễ thôi, code thế này:

Mã: 
Sub PhanTichDuLieu()
    Dim objDict As Object
    Dim arrData, arrResult
    Dim shtData As Worksheet
    Dim e As Long, m As Long, n As Long, r As Long, u As Long
    Set objDict = CreateObject("scripting.dictionary")
    Set shtData = Worksheets("Data")
    e = shtData.Range("F" & shtData.Rows.Count).End(xlUp).Row
    arrData = shtData.Range("B2:J" & e).Value
    u = UBound(arrData)
    ReDim arrResult(1 To u, 1 To 5)
    For r = 1 To u
        If objDict.Exists(arrData(r, 5)) Then
            m = objDict.Item(arrData(r, 5))
            If arrData(r, 1) = 2013 Then
                arrResult(m, 2) = arrResult(m, 2) + arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(m, 3) = arrResult(m, 3) + arrData(r, 9)
            End If
            arrResult(m, 4) = arrResult(m, 3) - arrResult(m, 2)
            If arrResult(m, 2) <> 0 Then
                arrResult(m, 5) = arrResult(m, 4) / arrResult(m, 2)
            End If
        Else
            n = n + 1
            objDict(arrData(r, 5)) = n
            arrResult(n, 1) = arrData(r, 5)
            If arrData(r, 1) = 2013 Then
                arrResult(n, 2) = arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(n, 3) = arrData(r, 9)
            End If
            arrResult(n, 4) = arrResult(n, 3) - arrResult(n, 2)
            If arrResult(n, 2) <> 0 Then
                arrResult(n, 5) = arrResult(n, 4) / arrResult(n, 2)
            End If
        End If
    Next
    Worksheets("Pivot").Range("G4:K4").Value = Array("Reporter ISO", "2013", "2014", "T" & ChrW(259) & "ng gi" & ChrW(7843) & "m", _
                                               "Bi" & ChrW(7871) & "n " & ChrW(273) & ChrW(7897) & "ng")
    Worksheets("Pivot").Range("G5:K5").Resize(n).Value = arrResult
End Sub
Nhấp chuột vào đây để mở rộng...
Sort cột G từ A-Z mới giống bên Pivot.
Bạn hiền "Chơi kiểu" khó nhìn muốn chết, lại cộng trừ nhân chia "từng phát" hao đạn quá.
Thêm một vòng lặp như vầy để cộng trừ nhân chia chắc cũng không lâu lắm nhỉ?
PHP: 
For r = 1 To u
        If Not objDict.Exists(arrData(r, 5)) Then
            n = n + 1
            objDict(arrData(r, 5)) = n
            arrResult(n, 1) = arrData(r, 5)
            If arrData(r, 1) = 2013 Then
                arrResult(n, 2) = arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(n, 3) = arrData(r, 9)
            End If
        Else                   'objDict.Exists (arrData(r, 5))'
            m = objDict.Item(arrData(r, 5))
            If arrData(r, 1) = 2013 Then
                arrResult(m, 2) = arrResult(m, 2) + arrData(r, 9)
            ElseIf arrData(r, 1) = 2014 Then
                arrResult(m, 3) = arrResult(m, 3) + arrData(r, 9)
            End If
        End If
    Next r
    '=================================='
    For r = 1 To n
        arrResult(r, 4) = arrResult(r, 3) - arrResult(r, 2)
        If arrResult(r, 2) <> 0 Then arrResult(r, 5) = arrResult(r, 4) / arrResult(r, 2)
    Next r
    '=================================='
 
Upvote 0
Upvote 0
Upvote 0
Cá ngừ F1 đã viết:
Chào bạn, tôi vừa có addin, thử với lệnh SQL này lại báo lỗi, để đếm bỏ trùng các Partner, tôi bỏ Count đi thì ra kết quả loại trùng (vùng khoanh đỏ trên hình), mà đưa lệnh count vào để đếm lại báo lỗi syntax.

View attachment 266616
Nhấp chuột vào đây để mở rộng...
Lỗi cú pháp nhé em. Thử như sau:

Mã: 
Select Count(*) From (Select Distinct Partner From [Data$])
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Thêm cho bạn một cách nhé:
Mã: 
Sub Gop_HLMT()
    Dim strValue As String, str2013 As String, str2014 As String, i As Integer
    str2013 = "IIf([Year]=2013,[Trade Value (US$)],0)"
    str2014 = "IIf([Year]=2014,[Trade Value (US$)],0)"
    With CreateObject("ADODB.Recordset")
        .Open "SELECT [Reporter ISO], sum(" & str2013 & ") as [2013],sum(" & str2014 & ") as [2014],sum(" & str2014 & ")-sum(" & str2013 & ") as [Tang Giam],(sum(" & str2014 & ")-sum(" & str2013 & "))/sum(" & str2013 & ") as [Bien Dong] FROM [Data$] Where [Trade Value (US$)]>0 Group By [Reporter ISO]", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet1.Range("G5").CopyFromRecordset .DataSource
        For i = 0 To .Fields.Count - 1
            Sheet1.Cells(4, i + 7) = .Fields(i).Name
        Next
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cái này bay giờ em muốn Cột năm str2013 ...n. không xác định số cột thì sửa làm sao anh hihi
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

hoanggiang1811
File excel bị nhảy trang in khi máy dùng màn hình CRT
Trả lời
6
Đọc
4K
pthau72
pthau72
T
Tổng hợp từ Sheet1 qua Sheet2
Trả lời
3
Đọc
48
hoangtuaotrang_hp_vn
H
T
Cần bạn viết phần mềm quản lý quán karaoke bằng excel
Trả lời
5
Đọc
108
VetMini
V
P
Hướng dẫn giải bài tập excel
Trả lời
1
Đọc
40
VetMini
V
ann266
Kế toán kho F&B
    • Cười
Trả lời
5
Đọc
84
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom