Mình có dữ liệu thông tin từ các sheet 1, 2, 3,.... mình muốn tổng hợp các sheet đó vào 1 sheet tổng hợp, nhờ các a/c chỉ dẫn công thức để khi có nhiều sheet 1,2,3 ...1000 thì sheet tổng hợp làm được nhanh hơn.
Tổng hợp dữ liệu từ các sheet 1, 2, 3,.... vào chung 1 sheet tổng hợp
- Thread starter henry6456
- Ngày gửi
Record Macro cách tổng hợp chết 1,2, và 3 .
Đưa code lên đây, bà con sẽ chỉ cho cách sửa thành tổng hợp 1000 sheets.
Đừng nói là không biết record macro nhé. Quản trị cả ngàn sheets mà không làm được thì kiếm việc khác làm đi.
Đưa code lên đây, bà con sẽ chỉ cho cách sửa thành tổng hợp 1000 sheets.
Đừng nói là không biết record macro nhé. Quản trị cả ngàn sheets mà không làm được thì kiếm việc khác làm đi.
nhờ bạn chỉ giáo giúp, do trước giờ mình chưa làm
Hoàng Tuấn 868
Đăng ký hôm qua
- Tham gia
- 9/11/19
- Bài viết
- 5,118
- Được thích
- 4,835
Từ trước tới giờ chưa làm mà đụng vào file cả ngàn sheet thì vụ này căng đây.
Chắc bạn vẽ đề bài kiểu nhìn xa trông rộng đúng không,
Chứ tầm 100 sheet là phải nghĩ cách làm khác rồi.
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,572
- Được thích
- 2,780
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Hỏi bạn @henry6456.
1/1000 sheet ấy nằm trong cùng 1 workbook hay nằm ở nhiều file khác nhau, các file ấy có cùng nằm chung trong 1 folder không?
2/Dữ liệu sheet nào cũng như có format sheet 1, 2,...999 hay khác nhau, số liệu thì ngoài mẫu 1, mẫu 2, còn có mẫu 3, 4,...n, hoặc ngoài số lượng, mầu sắc còn có trọng lượng, kích cỡ, quy cách....nữa.
Cái bạn cần hỏi là mỗi sheet trung bình có bao nhiêu dòng.
Nếu trung bình trên 1000 dòng thì khỏi tổng hợp. Phải dùng Data Model.
Cỡ Tiểu Đoàn, Trung Đoàn thì phải cấp Tá chỉ huy.
Cỡ Sư Đoàn thì phải cấp Tướng.
Công ty này giao cả một Quân Đoàn cho cấp Thượng sĩ/Thiếu Úy.
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,572
- Được thích
- 2,780
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Tôi muốn hỏi thêm bạn đó để code cho đúng chứ khi trả bài rồi lại ý này, ý nọ, thêm bớt chỗ nảy, chỗ kia,....còn code thì tôi đã có theo dữ liệu đã đăng trong file Mẫu.
Mã:
Sub LayDuLieu()
Dim i&, Lr&
Dim Sh As Worksheet, Ws As Worksheet
Set Ws = Sheets("Tổng hợp")
For Each Sh In Worksheets
If Sh.Name <> "Tổng hợp" Then
Sh.Range("B1:C3,B6:C7").Copy
Lr = Ws.Range("D10000").End(xlUp).Row + 1
Sheet1.Select
Ws.Range("A" & Lr).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End If
Next Sh
MsgBox "done"
End Sub1/ Xem code này có thể cải tiến nữa (chỉ thỏa mãn yêu cầu theo dữ liệu đã đăng) được không?
2/Trong trường hợp như bài#7 tôi hỏi thì không thể dùng code này mà phải viết code khác, Hướng của tôi là : dùng Application.FileDialog(msoFileDialogFilePicker) để lấy lập 1 mảng Array chứa các file có Dữ liệu cần lấy (tạm gọi là Arr(FileN= dữ liệu nguồn) ) dùng vòng lặp duyệt từng phần tử của Arr(fileN) và mở chúng (Set Wb = open. ThisWorkboo(Arr(i)))=> duyệt từng Sheet trong workbook mới mở đó (for each Sh in ThisWorkbook.Sheets)=> kiểm tra dữ liệu cần lấy nằm ở chỗ nào? cấu trúc ra sao? dùng copy và Paste (code trên) hay phải dùng cách khác để lấy?,.....=> lấy dữ liệu của sheet đó , lần lượt hết các sheet=> đóng Workbook=> duyệt sang Workbook khác (arr(i+1)) , cứ vậy lần lượt đến hết.
Nếu có thể anh có thể chỉ cho tôi và nhiều bạn khác quan tâm 1 hướng đi dễ hiểu nhất bằng VBA được không?Tất nhiên là không dùng DataMode.
Trân trọng cảm ơn anh.
Tóm lược:
- Bạn có môt sheet chủ, gọi là Ws, và cần copy từ các sheets còn lại (sh).
Như vậy bạn chỉ cần 2 dòng, 1 dòng copy 2 cái areas, và dòng kia pasteSpecial
Sh.Range("B1:C3,B6:C7").Copy
Ws.Range("A" & Ws.Range("D10000").End(xlUp).Row + 1).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Bạn viết thành nhiều dòng cũng chẳng giúp gì được cho code dễ đọc, dễ hiểu.
Muốn code dễ hiểu thì viết hàm lấy cái dòng cuối ấy.
Function LastUsedRow(ws as worksheet, cot as variant) As Long
LastUsedRow = ws.Cells(10000, cot).End(xlUp).Row ' cot muốn là số hay chữ đều được
End Function
Select là một lệnh không nên dùng nhiều, dùng một hồi, chả nhớ Selection là cái gì.
Nếu bạn sửa
If Sh.Name <> "Tổng hợp" Then
Thành
If Sh.Name <> Ws.Name Then
Thì tránh được một lần phải gõ chuỗi 'magic'
Với câu 2/ của bạn. Tôi chỉ thắc mắc là làm xong rồi thì đọc dữ liệu có biết chúng được lấy từ đâu ra (file/sheet) không?
Cái Dialog hiển nhiên là cho phép bạn chọn nhiều files khác nhau. Làm sao bạn biết mình chọn dư hay thiếu?
(gợi ý, lập một hidden sheet ghi lại các files và sheets đã copied)
- Tham gia
- 8/6/06
- Bài viết
- 14,336
- Được thích
- 22,383
- Nghề nghiệp
- Nuôi ba ba & trùn quế
Trong 1 địa phương có nhiều công ti thì sao ta?
| Ngày | Địa chỉ | Đơn vị | Mẫu | ||||||||
| 4/1/2024 | Quy Nhơn | Công ty A | 23 | Đỏ | |||||||
| 24 | Đen | ||||||||||
| 4/4/2024 | Hà Nội | Công ty B | 60 | Trắng | |||||||
| 87 | Xanh | ||||||||||
| 4/12/2024 | Hà nội | Công ty C | 80 | Hồng | |||||||
| 215 | Cam | ||||||||||
| 4/1/2024 | TP HCM | Công ti Z | 153 | Trăắng | |||||||
| 248 | Nâu | ||||||||||
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,572
- Được thích
- 2,780
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Trân trọng cảm ơn Anh @VetMini đã xem bài và chỉ dẫn, gợi ý.
Sh.Range("B1:C3,B6:C7").Copy Ws.Range("A" & dongcuoi+ 1).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Tức là chuyển 2 dòng thành 1 dòng thì luôn bị lỗi. mà cứ phải Select cái Ws.name ấy thì mới chạy và code vẫn cứ là 3 dòng: dòng 1: Copy; dòng 2 : select ; dòng 3: Paste...
Tôi đã giải quyết các vấn đề trên (thay vì dùng 1 Sheet ẩn để ghi lại những files và sheet đã copy) thì dùng thêm 1 cột ( ví dụ là cột Z) để ghi lại các file và sheet đã lấy dữ liệu (dùng code), trước khi mở file code sẽ kiểm tra tên file ấy đã có trong cột Z ấy, nếu chưa có thì mở file, đã có thì hỏi => trả lời Yes thì ... mở và ghi thêm, No thì bỏ qua).
Không hiểu sao khi tôi
Sh.Range("B1:C3,B6:C7").Copy Ws.Range("A" & dongcuoi+ 1).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Tức là chuyển 2 dòng thành 1 dòng thì luôn bị lỗi. mà cứ phải Select cái Ws.name ấy thì mới chạy và code vẫn cứ là 3 dòng: dòng 1: Copy; dòng 2 : select ; dòng 3: Paste...
Tôi đã giải quyết các vấn đề trên (thay vì dùng 1 Sheet ẩn để ghi lại những files và sheet đã copy) thì dùng thêm 1 cột ( ví dụ là cột Z) để ghi lại các file và sheet đã lấy dữ liệu (dùng code), trước khi mở file code sẽ kiểm tra tên file ấy đã có trong cột Z ấy, nếu chưa có thì mở file, đã có thì hỏi => trả lời Yes thì ... mở và ghi thêm, No thì bỏ qua).
Lần chỉnh sửa cuối:
CÁM ơn bạn đã viết giúp code, đúng theo ý mình cần.
Nhờ bạn viết giúp mình code file này với nhé. Cảm ơn bạn.
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,572
- Được thích
- 2,780
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Thích thì chiều. Code có thể cho kết quả đúng với dữ liệu đã có.
Mã:
Sub LayDL()
Dim t&, k&, KQ()
Dim Sh As Worksheet, Ws As Worksheet
Set Ws = Sheets("TH")
ReDim KQ(1 To 2 * Worksheets.Count, 1 To 13)
For Each Sh In Worksheets
If Sh.Name <> Ws.Name Then
If Sh.[F6] <> Empty Or Sh.[F7] <> Empty Or Sh.[F8] <> Empty Then
t = t + 1: k = k + 1
KQ(t, 1) = k
KQ(t, 2) = Sh.[F6]
KQ(t, 3) = Sh.[F7]
KQ(t, 4) = Sh.[F8]
KQ(t, 5) = Sh.[R7]
KQ(t, 6) = Sh.[O12]
KQ(t, 7) = Sh.[O13]
KQ(t, 8) = Sh.[O14]
KQ(t, 9) = Sh.[O16]
KQ(t, 10) = Sh.[O21]
KQ(t, 11) = KQ(t, 8) / KQ(t, 9)
KQ(t, 12) = Sh.[O28]
KQ(t, 13) = KQ(t, 11) / (1 + KQ(t, 12) / 100)
t = t + 1
KQ(t, 6) = Sh.[S12]
KQ(t, 7) = Sh.[S13]
KQ(t, 8) = Sh.[S14]
KQ(t, 9) = Sh.[S16]
KQ(t, 10) = Sh.[S21]
KQ(t, 11) = KQ(t, 8) / KQ(t, 9)
KQ(t, 12) = Sh.[S28]
KQ(t, 13) = KQ(t, 11) / (1 + KQ(t, 12) / 100)
End If
End If
Next Sh
If t Then
Ws.Range("A5").Resize(100, 13).ClearContents
Ws.Range("A5").Resize(t, 13) = KQ
End If
MsgBox "Thành công"
End Suba = [ {"", "F6", "F7", "F8", "R7", 12, 13, 14, 16, 21} ]
For Each Sh In Worksheets
If Sh.Name <> Ws.Name Then
If Sh.[F6] <> Empty Or Sh.[F7] <> Empty Or Sh.[F8] <> Empty Then
t = t + 1: k = k + 1
GoSub DOAN_1
cot = "O"
GoSub DOAN_2
t = t + 1
cot = "S"
GoSub DOAN_2
...
Exit Sub ' dong nay phai di truoc cac labels
' sub noi, dung de ghi doan 1
DOAN_1:
KQ(t, 1) = k
For i = 2 to 5
KQ(t, i) = Sh.Range(a(i))
Next i
Return
' sub noi, dung de ghi doan 2 va 3
DOAN_2:
For i = 6 To 10
KQ(t, i) = Sh.Range(cot & a(i))
Next i
KQ(t, 11) = KQ(t, 8) / KQ(t, 9)
KQ(t, 12) = Sh.Range(cot & 28)
KQ(t, 13) = KQ(t, 11) / (1 + KQ(t, 12) / 100)
Return
End Sub
HUONGHCKT
Zalo 0986997214
- Tham gia
- 30/8/12
- Bài viết
- 1,572
- Được thích
- 2,780
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Cảm ơn anh @VetMini . Tôi cũng đã làm theo kiểu xác định tọa độ (dòng và cột) đưa vào 2 mảng (X và Y) sau đó cho chạy vòng lặp để lấy, song cảm thấy nó sẽ khó hiểu và khó sửa (đối với người ít tiếp xúc với VBA) nên tôi đã làm theo cách 1 (bài#15)
Mã:
Sub LayDuLieu()
Dim X, Y, t&, k&, d&, KQ()
Dim Sh As Worksheet, Ws As Worksheet
Set Ws = Sheets("TH")
X = Array(, , 5, 7, 8, 7, 12, 13, 14, 16, 21)
Y = Array(, , 6, 6, 6, 18, 15, 15, 15, 15, 15)
ReDim KQ(1 To 2 * Worksheets.Count, 1 To 13)
For Each Sh In Worksheets
If Sh.Name <> Ws.Name Then
If Sh.[F6] <> Empty Or Sh.[F7] <> Empty Or Sh.[F8] <> Empty Then
t = t + 1: k = k + 1
KQ(t, 1) = k
For d = 2 To 10
KQ(t, d) = Sh.Cells(X(d), Y(d))
Next d
KQ(t, 11) = KQ(t, 8) / KQ(t, 9)
KQ(t, 12) = Sh.[O28]
KQ(t, 13) = KQ(t, 11) / (1 + KQ(t, 12) / 100)
t = t + 1
For d = 6 To 10
KQ(t, d) = Sh.Cells(X(d), Y(d) + 4)
Next d
KQ(t, 11) = KQ(t, 8) / KQ(t, 9)
KQ(t, 12) = Sh.[S28]
KQ(t, 13) = KQ(t, 11) / (1 + KQ(t, 12) / 100)
End If
End If
Next Sh
If t Then
Ws.Range("A5").Resize(100, 13).ClearContents
Ws.Range("A5").Resize(t, 13) = KQ
End If
MsgBox "Thành công"
End Sub
