Nhờ giúp code tổng hợp dữ liệu từ Sheet này sang Sheet khác (1 người xem)
- Thread starter Qalo
- Ngày gửi
Người dùng đang xem chủ đề này
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Cái vụ này mà dùng công thức thì có vẻ hơi oải đấy.
Bạn sử dụng code sau xem:
[GPECODE=vb]Sub TongHop()
Dim Tmp, Arr(), i As Long, j As Long, k As Long
Sheet2.[A2:E65000].ClearContents
Tmp = Sheet1.[A2:Q10000]
ReDim Arr(1 To 5 * UBound(Tmp), 1 To 5)
For i = 1 To UBound(Tmp)
If Tmp(i, 1) = "" Then Exit For
For j = 3 To 15 Step 3
If Tmp(i, j) = "" Then Exit For
k = k + 1
Arr(k, 1) = Tmp(i, 1): Arr(k, 2) = Tmp(i, 2)
Arr(k, 3) = Tmp(i, j): Arr(k, 4) = Tmp(i, j + 1): Arr(k, 5) = Tmp(i, j + 2)
Next
Next
Sheet2.[A2].Resize(k, 5).Value = Arr
End Sub[/GPECODE]
Upvote
0
Cám ơn bạn NghiaPhuc, bạn có thể giải thích giúp mình cái Code đó không vì có thể cái bảng tính sheet 1 nó to hơn nữa. Ví dụ không phải là 5 project mà tới 10 project trên 1 hàng chẳng hạn. Mình hiểu cái code thì có thể áp dụng được. Cảm ơn bạn.
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Tổng quát hơn một chút:
[GPECODE=vb]Sub TongHop()
Dim Tmp, Arr(), i As Long, j As Long, k As Long
Sheet2.[A2:E65000].ClearContents 'Xóa dữ liệu hiện có trên Sheet2
Tmp = Sheet1.[A2:IV10000] 'Gán giá trị vùng dữ liệu trên Sheet1 vào biến Tmp (có mở rộng số cột)
ReDim Arr(1 To 10 * UBound(Tmp), 1 To 5) 'Khai báo lại số chiều cho biến mảng Arr, bạn có thể sửa số 10 bằng số Project cụ thể hoặc lớn hơn
For i = 1 To UBound(Tmp) 'Bắt đầu duyệt mảng Tmp
If Tmp(i, 1) = "" Then Exit For 'Nếu cột đầu tiên trống thì không duyệt nữa (hết dữ liệu)
For j = 3 To UBound(Tmp, 1) Step 3 'Duyệt qua vùng dữ liệu của các Project (từ cột 3 trở đi, nhóm 3 cột mỗi lần duyệt)
If Tmp(i, j) = "" Then Exit For 'Nếu cột Project tương ứng trống thì không duyệt nữa vì đã hết Project
k = k + 1 'Tăng biến đếm lên 1 đơn vị, tương ứng số phần tử hiện tại của mảng Arr
Arr(k, 1) = Tmp(i, 1): Arr(k, 2) = Tmp(i, 2) 'Gán Date và Name
Arr(k, 3) = Tmp(i, j): Arr(k, 4) = Tmp(i, j + 1): Arr(k, 5) = Tmp(i, j + 2) 'Gán Project, Task và Duration
Next
Next
Sheet2.[A2].Resize(k, 5).Value = Arr 'Gán giá trị mảng Arr lên Sheet2
End Sub[/GPECODE]
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Kệ nó, có hay không thì cũng cứ đưa vào mảng, nếu không có thì dữ liệu của cột Comment tương ứng sẽ để trống. Code chỉ quan tâm đến các cột Project, hễ cột này có giá trị thì sẽ đưa giá trị của nhóm 4 cột tương ứng vào mảng.
Code lúc đó như vầy (chú ý chỗ màu đỏ):
Mã:
Sub TongHop()
Dim Tmp, Arr(), i As Long, j As Long, k As Long
Sheet2.[A2:E65000].ClearContents
Tmp = Sheet1.[A2:IV10000]
ReDim Arr(1 To 10 * UBound(Tmp), 1 To [COLOR=#ff0000][B]6[/B][/COLOR])
For i = 1 To UBound(Tmp)
If Tmp(i, 1) = "" Then Exit For
For j = 3 To UBound(Tmp, 1) Step [B][COLOR=#ff0000]4[/COLOR][/B]
If Tmp(i, j) = "" Then Exit For
k = k + 1
Arr(k, 1) = Tmp(i, 1): Arr(k, 2) = Tmp(i, 2)
Arr(k, 3) = Tmp(i, j): Arr(k, 4) = Tmp(i, j + 1)
Arr(k, 5) = Tmp(i, j + 2): [COLOR=#ff0000][B]Arr(k, 6) = Tmp(i, j + 3)[/B][/COLOR]
Next
Next
Sheet2.[A2].Resize(k, [COLOR=#ff0000][B]6[/B][/COLOR]).Value = Arr
End Sub
Upvote
0
Mình đã tự sửa code đó theo bạn hướng dẫn và kết quả y như bạn vừa mới viết ra đây giúp mình. Bây giờ mình còn 1 thắng mắc là cái nút "Tổng Hợp" bạn làm như thế nào vậy?
Cái VBA này giới hạn của nó là bao nhiêu dòng excel vậy bạn? Ý mình là sheet 1 tối đa được bao nhiêu dòng thì vượt quá khả năng của code này?
Cái VBA này giới hạn của nó là bao nhiêu dòng excel vậy bạn? Ý mình là sheet 1 tối đa được bao nhiêu dòng thì vượt quá khả năng của code này?
Upvote
0
Lê Duy Thương
Cạo lấy gì gội (Dịch quá không gội được)
- Tham gia
- 14/10/09
- Bài viết
- 3,113
- Được thích
- 4,852
ngoài vùng này thì không lấy dữ liệu nữa IV10000
nhập được chừng này là đuối rồi
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Về cái nút "Tổng hợp" thì bạn chọn tab Developer (nếu không thấy tab này thì click phải, chọn Customize the Ribbon và tick chọn nó), nhấn nút Insert\Button (Form control), vẽ nó lên sheet rồi Assign cho nó Macro TongHop.
Đơn giản hơn thì bạn cũng có thể vẽ một đối tượng Shape bất kỳ, click phải và Assign Macro TongHop.
Về vấn đề giới hạn thì tôi cũng không biết đâu, tuy nhiên với code trên, nếu để ý chỗ A2:IV10000 thì nếu số dòng >=10000 thì sẽ bị "tràn" dữ liệu. Bạn có thể sửa số 10000 cho phù hợp, nhưng có lẽ bấy nhiêu cũng đủ rồi.
Upvote
0
Mình đã sử dụng code này và nó hoạt động rất tốt. Mình đặt ra thêm 1 vấn đề nhờ các bạn giúp đỡ.
Vẫn với bảng excel đó, hằng ngày Sheet 1 được add thêm data mới. Khi đó nhấn vào nút "Tổng hợp" thì nó phải duyệt lại từ đầu để tổng hợp lại bảng mới ở Sheet 2.
Có cách nào (code nào) để khi nhấn vào nút "Tổng hợp" thì excel update tiếp cái bảng đã có ở sheet 2 mà không phải trở lại từ đầu không?
Vẫn với bảng excel đó, hằng ngày Sheet 1 được add thêm data mới. Khi đó nhấn vào nút "Tổng hợp" thì nó phải duyệt lại từ đầu để tổng hợp lại bảng mới ở Sheet 2.
Có cách nào (code nào) để khi nhấn vào nút "Tổng hợp" thì excel update tiếp cái bảng đã có ở sheet 2 mà không phải trở lại từ đầu không?
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Bạn cứ yên tâm đi, code chạy cái rẹt là xong chứ có gì mà phải bận tâm đến chuyện cái có rồi với cái chưa có đâu. Bạn cứ thử thêm vài ngàn dòng dữ liệu rồi chạy code xem mất bao nhiêu giây.
Upvote
0
Mình còn cần 1 macro giúp replace all nhiều thứ cùng 1 lúc với nhau, Ví dụ replace A thành B, replace D thành E và replace F thành G. liệu VBA có làm được điều này không?
Upvote
0
Mình tìm được code này
Sub ReplaceText()
Dim c As Range
For Each c In ActiveSheet.UsedRange
c = Replace(c, "Text to find", "Text to replace")
Next
End Sub
Nhưng xem ra nó phải đọc nguyên cả sheet và cũng ko thể giới han tìm trong 1 columne thôi được. Có vẻ code này chạy rất nặng. Giúp mình với.
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Việc này không khó, cần 2 mảng (có thể là hằng mảng hoặc lấy từ bảng tra trên sheet). Tiếp theo sử dụng một vòng lặp duyệt mảng nguồn và thay thế bằng giá trị tương ứng trên mảng đích, sử dụng phương thức Replace. Để trưa nay tôi viết thử, bây giờ online bằng điện thoại nên không làm được.
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Đây là một ví dụ về code thay thế hàng loạt trên 1 vùng:
[GPECODE=vb]Sub ReplaceText()
Dim Sou, Des, i As Long
Sou = Array("A", "C", "E", "G")
Des = Array("B", "D", "F", "H")
For i = 1 To UBound(Sou)
Sheet1.[A1:F100].Replace Sou(i), Des(i), xlWhole
Next
End Sub[/GPECODE]
Bạn có thể thay đổi theo yêu cầu:
- Các biến Sou, Des nhận các giá trị khác, có thể là 2 vùng tương ứng trên sheet (lưu ý: 2 mảng này phải có cùng số phần tử).
- Vùng Sheet1.A1:F100 có thể thay bởi vùng khác
- xlWhole có thể thay bởi xlPart nếu bạn chỉ muốn tìm kiếm các từ có trong ô (chứ không phải nội dung cả ô)
- Thêm , MatchCase:=True vào sau xlWhole nếu muốn phân biệt chữ hoa, chữ thường.
Upvote
0
Mình đang phải tổng hợp lại các dữ liệu cũ mà nếu gõ lại từ đầu hoặc copy paste bằng tay không chỉ mất thời gian mà nguy cơ sai cũng rất cao. Nay mình lại có một bảng dữ liệu dạng Sheet 1 cần chuyển giống như Sheet 2. Các cột A B C D là không đổi nhưng cột E F G H (có thể nhiều hơn nữa).. cần phải chuyển lại dạng hàng dọc và thành 2 cột Name và Time spent (như sheet 2)
Nhờ các bạn giúp mình code để chuyển đổi nhanh và chính xác.
Cám ơn các bạn.
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Bạn dùng code này nhé:
[GPECODE=vb]Sub TongHop()
Dim Tmp, Arr(), i As Long, j As Long, k As Long
Application.ScreenUpdating = False
Sheet2.[A2:F65000].Clear
Tmp = Sheet1.[A1:IV10000]
ReDim Arr(1 To UBound(Tmp), 1 To 6)
For i = 2 To UBound(Tmp)
If Tmp(i, 1) = "" Then Exit For
k = k + 1
For j = 1 To 4
Arr(k, j) = Tmp(i, j)
Next
For j = 5 To UBound(Tmp, 1)
If Len(Tmp(i, j)) Then
Arr(k, 5) = Tmp(1, j)
Arr(k, 6) = Tmp(i, j)
Exit For
End If
Next
Next
With Sheet2.[A2]
.Resize(k).NumberFormat = "dd/MMM"
.Resize(k, 6).Value = Arr
.Resize(k, 6).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
End Sub[/GPECODE]
Upvote
0
Bạn Nghiaphuc thật giỏi và giải đáp rất nhanh, rất cảm ơn bạn giúp đỡ.
Upvote
0
- Tham gia
- 19/12/10
- Bài viết
- 2,587
- Được thích
- 5,774
- Nghề nghiệp
- Công nhân vệ sinh số liệu
Nếu muốn tiết kiệm bộ nhớ 1 chút thì bạn có thể thay dòng này trong code của anh Phúc :
Tmp = Sheet1.[A1:IV10000]
Bằng đoạn này :
PHP:
With Sheet1
Tmp = Range(.Cells(1, 1), .Cells(Sheet1.[A65536].End(xlUp).Row, .[IV1].End(xlToLeft).Column))
End With
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Cái vụ End(xlUp), End(xlToLeft) này thì anh cũng có biết, và lúc đầu viết code cũng có nghĩ đến nó, nhưng mà nghĩ lại: Đã dùng đến mảng thì cứ vô tư đi mà, "kệ tía" nó. Hơn nữa, trong vòng 2 vòng For, anh đã đặt sẵn lệnh Exit For, hễ "gặp thời cơ" là nó thoát ngay thôi mà.
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 19/12/10
- Bài viết
- 2,587
- Được thích
- 5,774
- Nghề nghiệp
- Công nhân vệ sinh số liệu
Thực ra bàn chuyện nhanh hay chậm thì em không bàn, có lẽ là do thói quen "tiết kiệm" của mỗi người khi viết code thôi. Cái này em nghĩ cũng chỉ là tiểu tiết vì thuật toán thì code của anh quá chuẩn rùi, riêng em em cho rằng khi gán thằng Tmp = cả vùng A1:IV10000 thì máy tính đã phải đọc hết số phần tử đó vào bộ nhớ máy tính rùi khi Ubound nó để Redim xác định kích cỡ của mảng Arr qua Tmp thì nó hơi mệt xíu thôi ạ! Chắc là bệnh của em, hihihi
Upvote
0
- Tham gia
- 25/9/09
- Bài viết
- 5,729
- Được thích
- 8,858
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên
Lúc trước anh cũng hay dùng đến mấy cái End() này, nhưng từ khi làm quen với mảng (món này anh còn biết sau em xa) thì tự nhiên "lười", mà hình như cái "bệnh lười" này là anh nhiễm từ anh ndu đấy.
Upvote
0
