nhờ bạn chỉ giáo giúp, do trước giờ mình chưa làmRecord 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.
nhờ bạn chỉ giáo giúp, do trước giờ mình chưa làm
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.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.
Chắc bạn vẽ đề bài kiểu nhìn xa trông rộng đúng không,nhờ bạn chỉ giáo giúp, do trước giờ mình chưa làm
Hỏi bạn @henry6456.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.
Cái bạn cần hỏi là mỗi sheet trung bình có bao nhiêu dòng.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ỡ Tiểu Đoàn, Trung Đoàn thì phải cấp Tá chỉ huy.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.
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.
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 Sub
Tóm lược:...
1/ 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?
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 | ||||||||||
Không hiểu sao khi tôiTó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
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)
CÁM ơn bạn đã viết giúp code, đúng theo ý mình cần.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.
Nhân tiện đây muốn nhờ anh @VetMini :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 Sub
1/ 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ô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.
Nhân tiện đây muốn nhờ anh @VetMini :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 Sub
1/ 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
Nhờ bạn viết giúp mình code file này với nhé. Cảm ơn bạn.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.
Nhân tiện đây muốn nhờ anh @VetMini :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 Sub
1/ 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.
Thích thì chiều. Code có thể cho kết quả đúng với dữ liệu đã có.Nhờ bạn viết giúp mình code file này với nhé. Cảm ơn bạn.
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 Sub
a = [ {"", "F6", "F7", "F8", "R7", 12, 13, 14, 16, 21} ]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 Sub
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)a = [ {"", "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
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