- Tham gia
- 21/12/07
- Bài viết
- 1,902
- Được thích
- 5,303
- Nghề nghiệp
- Kinh doanh các mặt hàng văn phòng phẩm
dùng công thức thôi, có cho xài cột phụ không vậy?
À, do đây là topic tìm giải pháp nên mọi giải pháp đều được hoan nghênh.
Nhưng nếu không dùng cột phụ thì càng hay.
Sub Loc()
Range("F2").FormulaR1C1 = "=IF(OR(RC[-5]="""",RC[-5]=R[-1]C[-5]),"""",RC[-5])"
Range("G2").FormulaR1C1 = _
"=IF(ROW()=ROWS(TEN)+2,""TONG CONG"",IF(ROW()>ROWS(TEN)+2,"""",IF(RC[-1]<>"""",""Tong SL SP"",IF(ROW()-ROW(SP)>COUNT(STT),"""",INDEX(SP,MATCH(SMALL(STT,ROW()-ROW(SP)),STT,0),1)))))"
Range("H2").FormulaR1C1 = _
"=IF(RC[-1]=""TONG CONG"",SUM(OFFSET(R2C[-5],,,ROWS(TEN))),IF(RC[-2]<>"""",SUM(OFFSET(R[1]C,,,COUNT(STT))),SUMIF(SP,RC[-1],SL)))"
Range("F2:H2").AutoFill Destination:=Range("KQ"), Type:=xlFillDefault
End Sub
Boyxin ơi! Record macro kiểu này khó đọc quá!
Hi...hi...
Bài toán này gần tương tự với:
http://www.giaiphapexcel.com/forum/showthread.php?t=12619
Làm đc cái kia thì làm đc cái này (chẳng khác nhau gì mấy)
Phuùuuuuuu
Em xin góp 1 cách. Các bác góp ý bổ xung thêm để em tiến bộ nha
Không dùng cột phụ Sort dữ liệu theo cột A Dùng Name động để xử lý
Boyxin ơi cố lên... sắp... sắp... rồi... tôi ũng hộ nè...Bác làm gần ra rồi đó, nhưng.......
Bác làm gần ra rồi đó, nhưng chỉ mỗi cái là Bác lại làm thay đổi dữ liệu gốc, mà cái này lại là cái quan trong nhất. Bác thử làm không dùng đến cột phụ mà vẫn không làm thay đổi dữ liệu gốc xem.
To Bác Anhtuan1066 : Về ý nghĩa thì 2 bài toán gần giống nhau nhưng về thuật toán thì bài này khác bài kia và dĩ nhiên là khó hơn, bài kia em đã gửi file lên rồi mà.
Bác làm tiếp luôn bài này nha. Sau đợt này chắc tay nghề VBA của Bác tiến bộ lắm đây.
Khổ cái đề bài không nói chỗ nào quan trọng nhất không được thay đổi nên vô tình không may lại chạm tay vào đúng huyệt hiểm. hiiiiiiii chán thậtđây là topic tìm giải pháp nên mọi giải pháp đều được hoan nghênh.
Okie, đang trông chờ mọi sự ủng hộ, tiếp tay nè...Boyxin ơi cố lên... sắp... sắp... rồi... tôi ũng hộ nè...
he...he...
Option Explicit
Sub Loc()
Dim DS As Range, MH As Range, KH As Range, TempDS As Range
Dim SL As Range, TempKH As Range, LocKH As Range
Dim Er1 As Long, Er2 As Long, i As Long
Dim CT As String
Dim Luu As Variant
Application.ScreenUpdating = False
Call Xoa
Er1 = [A65536].End(xlUp).Row
Set DS = [A1].Resize(Er1, 3)
Set TempDS = [A1].Resize(Er1, 2)
Set KH = [A1].Resize(Er1, 1)
Set SL = KH.Offset(, 2)
Luu = DS.Value
DS.Sort Key1:=[A2], Key2:=[B2], Order1:=1, Order2:=1, Header:=1
TempDS.AdvancedFilter Action:=2, CopyToRange:=[F1:G1], Unique:=True
[C1].Copy Destination:=[H1]
Er2 = [G65536].End(xlUp).Row
Set LocKH = Range("F1:F" & Er2)
CT = "=SUMPRODUCT((R2C1:R1000C1=RC[-2])*(R2C2:R1000C2=RC[-1])*(R2C3:R1000C3))"
For i = Er2 To 2 Step -1
Set TempKH = LocKH(i).Resize(1, 3)
If LocKH(i) <> LocKH(i - 1) Then
TempKH.Copy
TempKH.Insert Shift:=xlDown
With LocKH(i)
.Offset(, 1) = "Tong SP"
.Offset(, 2) = Application.WorksheetFunction.SumIf(KH, .Value, SL)
.Offset(1, 2).Formula = CT
.Offset(1, 2).Value = .Offset(1, 2).Value
.Offset(1, 0).Clear
With .Resize(1, 3)
.Font.Bold = True
.Font.ColorIndex = 5
.Interior.ColorIndex = 35
End With
End With
Else:
With LocKH(i)
.Offset(, 2).Formula = CT
.Offset(, 2).Value = .Offset(, 2).Value
.Clear
End With
End If
Next i
With [G65536].End(xlUp).Offset(1, 0)
.Value = "TONG CONG"
.Font.Bold = True
.Offset(, 1) = Application.WorksheetFunction.Sum(SL)
With .Resize(1, 2).Font
.Bold = True
.ColorIndex = 3
End With
End With
DS.Value = Luu
Set DS = Nothing
Set TempDS = Nothing
Set KH = Nothing
Set SL = Nothing
Set LocKH = Nothing
Set TempKH = Nothing
Application.ScreenUpdating = True
End Sub
Sub Xoa()
Columns("F:H").Clear
End Sub
Sub loc()
Dim i As Long, r As Long
Dim KH As Range, SL As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set KH = [a2].Resize([a65536].End(xlUp).Row, 1)
Set SL = KH.Offset(, 2)
Range("F1:H65536").ClearContents
[A1].CurrentRegion.Resize(, 2).AdvancedFilter Action:=2, CopyToRange:=[F1:G1], Unique:=True
r = [F65536].End(xlUp).Row
[F2].Resize(r - 1, 2).Sort Key1:=[F2], Order1:=xlAscending, Key2:=[G2], Order2:=xlAscending
For i = r To 2 Step -1
If Cells(i, 6) = Cells(i - 1, 6) Then
Cells(i, 8).Formula = "=SUMPRODUCT((R2C1:R50000C1=RC[-2])*(R2C2:R50000C2=RC[-1])*(R2C3:R50000C3))"
Cells(i, 8) = Cells(i, 8).Value: Cells(i, 6).Clear
ElseIf Cells(i, 6) <> Cells(i - 1, 6) Then With Cells(i, 6)
.Resize(1, 3).Copy: .Resize(1, 3).Insert Shift:=xlDown
.Offset(, 2).Formula = "=SUMPRODUCT((R2C1:R50000C1=RC[-2])*(R2C2:R50000C2=RC[-1])*(R2C3:R50000C3))"
.Offset(, 2) = .Offset(, 2).Value: .Clear
.Offset(-1, 1) = "Tong SL SP"
.Offset(-1, 2) = Application.WorksheetFunction.SumIf(KH, Cells(i, 6).Value, SL)
End With
End If
Next i
With Cells([G65536].End(xlUp).Row, 7)
.Value = "TONG CONG": .Offset(, 1) = Application.WorksheetFunction.Sum(SL)
End With
[H1] = [C1]
Set KH = Nothing: Set SL = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Cách của Danh cũng chậm hơn là VBA từ Pivot. Chả hiểu sao!
Đương nhiên là được rồi! Nối chuổi thôi mà hoangdanh282vnChắc là Pivot thì tích hợp sẵn thằng Sumproduct theo dữ liệu có nên sẽ nhanh hơn.
Nếu trong code của em mà chèn được số dòng hiện hữu có trong DATA vào thằng Sumproduct thì sẽ nhanh hơn, vì em đưa tới 50.000 dòng vào nên nó tính chậm là đúng rồi.
Em chưa thử là đưa biến đếm số dòng của dữ liệu vào Sumproduct có được hay không, nếu được thì chắc sẽ nhanh không kém Pivot đâu
"=SUMPRODUCT((R2C1:R" & K & "C1=RC[-2])*(R2C2:R" & K & "C2=RC[-1])*(R2C3:R" & K & "C3))"
Có thể sai ở hàm SUMPRODUCT!ndu96081631
Bạn xem lại bài 12 thử file mình kéo xuống 5000 dòng thấy dữ liệu không thấy đúng.
Nếu như mình có dữ liệu như file đính kèm thì làm sao trích xuất dữ liệu là hay nhất.
Tới dòng 1000, bạn sửa lại thành số bao nhiêu tùy theo dử liệu của bạnCT = "=SUMPRODUCT((R2C1:R1000C1=RC[-2])*(R2C2:R1000C2=RC[-1])*(R2C3:R1000C3))"
ndu96081631
Bạn xem lại bài 12 thử file mình kéo xuống 5000 dòng thấy dữ liệu không thấy đúng.
Nếu như mình có dữ liệu như file đính kèm thì làm sao trích xuất dữ liệu là hay nhất.