- Tham gia
- 2/8/10
- Bài viết
- 5,218
- Được thích
- 9,002
- Giới tính
- Nam
Má ơi, sao có kiểu lọc gì oái oăm thế nàyFile dữ liệu có nhiều sheet, em muốn tổng hợp 3 vùng dữ liệu đã được đặt name động, với cột đầu là mã sp, cột cuối là số lượng. các vùng có kích thước khác nhau. Tổng hợp về mã sp duy nhất có số lượng >0.
Xin các thầy giúp !
Mình khoái mấy bài thế này, chơi đường tà đạo vầy xem sao. Xử lý bằng code hết, không tạo thêm name nào cảFile dữ liệu có nhiều sheet, em muốn tổng hợp 3 vùng dữ liệu đã được đặt name động, với cột đầu là mã sp, cột cuối là số lượng. các vùng có kích thước khác nhau. Tổng hợp về mã sp duy nhất có số lượng >0.
Xin các thầy giúp !
Sub tong()
Dim d As Object, dl(), sh As Worksheet, tong
Dim i As Long, FR As Long, FC As Long, LC As Long, dk1 As String, dk2 As String, n As Long
Set d = CreateObject("scripting.dictionary")
Set tong = Sheets("Tong")
dk1 = tong.[b5]: dk2 = tong.[c5]
For Each sh In Worksheets
If sh.Name <> "Tong" Then
With sh.UsedRange
FR = .Find(dk1).Offset(1).Row
FC = .Find(dk1).Column
LC = .Find(dk2).Column
End With
dl = sh.Range(sh.Cells(FR, FC), sh.Cells(65536, LC).End(3)).Value
n = UBound(dl, 2)
For i = 1 To UBound(dl)
If dl(i, n) > 0 Then
If Not d.exists(dl(i, 1)) Then
d.Add dl(i, 1), dl(i, n)
Else
d.Item(dl(i, 1)) = d.Item(dl(i, 1)) + dl(i, n)
End If
End If
Next
End If
Next
tong.[b6:c10000].ClearContents
tong.[b6].Resize(d.Count) = Application.Transpose(d.keys)
tong.[C6].Resize(d.Count) = Application.Transpose(d.items)
End Sub
Nếu có thêm vài sheet chẳng có dữ liệu gì cả thì sao nhỉ? Tôi thử thì bị lỗi mấy cái Find().Mình khoái mấy bài thế này, chơi đường tà đạo vầy xem sao. Xử lý bằng code hết, không tạo thêm name nào cả
Chỉ yêu cầu B5 và C5 của sheet Tong có tiêu đề Mã Sp và Số lượng, không có 2 ô này coi như code này tèo.
PHP:Sub tong() Dim d As Object, dl(), sh As Worksheet, tong Dim i As Long, FR As Long, FC As Long, LC As Long, dk1 As String, dk2 As String, n As Long Set d = CreateObject("scripting.dictionary") Set tong = Sheets("Tong") dk1 = tong.[b5]: dk2 = tong.[c5] For Each sh In Worksheets If sh.Name <> "Tong" Then With sh.UsedRange FR = .Find(dk1).Offset(1).Row FC = .Find(dk1).Column LC = .Find(dk2).Column End With dl = sh.Range(sh.Cells(FR, FC), sh.Cells(65536, LC).End(3)).Value n = UBound(dl, 2) For i = 1 To UBound(dl) If dl(i, n) > 0 Then If Not d.exists(dl(i, 1)) Then d.Add dl(i, 1), dl(i, n) Else d.Item(dl(i, 1)) = d.Item(dl(i, 1)) + dl(i, n) End If End If Next End If Next tong.[b6:c10000].ClearContents tong.[b6].Resize(d.Count) = Application.Transpose(d.keys) tong.[C6].Resize(d.Count) = Application.Transpose(d.items) End Sub
Tham gia "Quánh võ mèo" một cái xem.FR = sh.UsedRange.Find(dk1).Offset(1).Row
Public Sub GPE()
Dim Ws As Worksheet, Rng(), i As Long, n As Long, Dic As Object, K As Long, Arr(), Tem As Variant, SL As Double
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Arr(1 To 65000, 1 To 2)
For Each Ws In Worksheets
If Ws.Name Like "Dulieu*" Then
If Ws.UsedRange.Rows.Count > 1 Then
Rng = Ws.UsedRange.Value
n = UBound(Rng, 2)
For i = 2 To UBound(Rng, 1)
Tem = Rng(i, 1): SL = Rng(i, n)
If SL > 0 Then
If Not Dic.exists(Tem) Then
K = K + 1
Dic.Add Tem, K
Arr(K, 1) = Tem: Arr(K, 2) = Rng(i, n)
Else
Arr(Dic.Item(Tem), 2) = Arr(Dic.Item(Tem), 2) + Rng(i, n)
End If
End If
Next i
End If
End If
Next
Sheet1.[E6:F1000].ClearContents
Sheet1.[E6].Resize(K, 2).Value = Arr
Set Dic = Nothing
End Sub
Nếu vậy thì em phải thêm 1 cái bẫy lỗi rồiNếu có thêm vài sheet chẳng có dữ liệu gì cả thì sao nhỉ? Tôi thử thì bị lỗi mấy cái Find().
Sub tong()
Dim d As Object, dl(), sh As Worksheet, tong
Dim i As Long, FR As Long, FC As Long, LC As Long, dk1 As String, dk2 As String, n As Long
Set d = CreateObject("scripting.dictionary")
Set tong = Sheets("Tong")
dk1 = tong.[b5]: dk2 = tong.[c5]
For Each sh In Worksheets
If sh.Name <> "Tong" Then
If sh.UsedRange.Count > 1 Then
With sh.UsedRange
FR = .Find(dk1).Offset(1).Row
FC = .Find(dk1).Column
LC = .Find(dk2).Column
End With
dl = sh.Range(sh.Cells(FR, FC), sh.Cells(65536, LC).End(3)).Value
n = UBound(dl, 2)
For i = 1 To UBound(dl)
If dl(i, n) > 0 Then
If Not d.exists(dl(i, 1)) Then
d.Add dl(i, 1), dl(i, n)
Else
d.Item(dl(i, 1)) = d.Item(dl(i, 1)) + dl(i, n)
End If
End If
Next
End If
End If
Next
tong.[b6:c10000].ClearContents
tong.[b6].Resize(d.Count) = Application.Transpose(d.keys)
tong.[C6].Resize(d.Count) = Application.Transpose(d.items)
End Sub
Cám ơn bác Lợi nhiều, mà bác thèm "b" là thèm gì nhỉ?Má ơi, sao có kiểu lọc gì oái oăm thế này
Mới nghĩ được thế này thôi, bi giờ thấy đói bụng & thèm b.... quá
Thân
Tà đạo hay chính đạo mà đi đến được mục tiêu tốt thì nên đi phải không anh? Cám ơn anh nhiều !Mình khoái mấy bài thế này, chơi đường tà đạo vầy xem sao.
Cám ơn bác Ba Te, bước đầu em tìm hiểu code, mong bác chia sẻ vài chiêu võ "Tiểu hổ" của bác với !Tham gia "Quánh võ mèo" một cái xem.
Bài này dùng PivotTalbe là ngon lành nhất, sao Thảo không thử nhỉ?
Pivot nhiều vùng được không thầy? Em chỉ biết sử dụng Pivot trên 1 bảng dữ liệu thôi
Có 1 vấn đề mà tôi chưa biết: Với PivotTable, Làm sao ẩn giá trị Zero trong Value Fields?
Ngoài ra: Bài này nếu dùng ADO chắc.. dư sức qua cầu ha?
Ẹc... Ẹc...
Cóc thấy ẩn gì cả --> Nó cứ "lù lù" ở đó mà chẳng biết cách nào để ẩn cả
(hình post lên lại không Edit được ---> Ghét)
Ngoài ra: Bài này nếu dùng ADO chắc.. dư sức qua cầu ha?
Ẹc... Ẹc...
Sub TongHop_HLMT()
Set adoConn = New ADODB.Connection
Set adoRS = New ADODB.Recordset
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select F1, sum(F3) from " & _
"(SELECT F1, F3 FROM Name1 " & _
"Union ALL " & _
"SELECT F1, F6 FROM Name2 " & _
"Union ALL " & _
"SELECT F1, F6 FROM Name3) " & _
"group by F1 " & _
"having sum(F3)>0"
End With
[B6].CopyFromRecordset adoRS
adoRS.Close: Set adoRS = Nothing
adoConn.Close: Set adoConn = Nothing
End Sub
Cóc thấy ẩn gì cả --> Nó cứ "lù lù" ở đó mà chẳng biết cách nào để ẩn cả
Cho em hỏi về Page field trong Pivot Multi, mình chọn như thế nào? Gõ thế nào vào các ô Field ?
Bài này dùng ADO cũng khá thú vị:
1./ Đặt Name cho 3 vùng dữ liệu theo thứ tự từ Name1, Name2 và Name3.
2./ Gom 3 Name vào làm 1.
3./ Tính tổng 3 Name đó.
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2