Nhờ giúp để CODE hoạt động được với nhiều SHEET hơn nữa (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
T

tiendungnst

Thành viên chính thức
Tham gia
9/7/07
Bài viết
87
Được thích
5
Option Explicit
Sub BCTK(Folder As String, ShName As String, SrcRng As String, Target As Range)
Dim Temp As String
Temp = ShName & "'!" & Range(SrcRng).Address(, , 2)
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
ActiveWorkbook.Names.Add "Arr", "=""'" & Folder & "[""&Files(""" & Folder & "*.*"")&""]" & Temp & """"
Target.Consolidate Evaluate("Arr"), 9, 0, 1
ActiveWorkbook.Names("Arr").Delete
End Sub
Sub Tonghop()
Dim Folder As String, ShName As String, SrcRng As String
Range("B12:M27").ClearContents
With CreateObject("Shell.Application")
On Error Resume Next
Folder = .BrowseForFolder(0, "", 1).Self.Path
End With
ShName = "MAU1": SrcRng = "B12:M27"
BCTK Folder, ShName, SrcRng, Range("B12")
End Sub

Đoạn CODE trên mình copy được từ các cao thủ của GPE và mình chỉnh sửa lại để phục vụ yêu cầu công việc của mình thấy rất đúng với yêu cầu, nhưng vấn đề còn một tí vướng mắc là File Excel tổng hợp của mình có hơn 10 SHEET và các file dữ liệu cũng chung một mẫu, nhưng đoạn CODE trên chỉ tổng hợp cho một SHEET có tên là "MAU1". Vậy đoạn CODE phải chỉnh sửa như thế nào để tất cả các SHEET trong File có thể tổng hợp dữ liệu từ các SHEET tương ứng của các File nguồn
Nhờ các ACE GPE xem và giúp ah. Xin cảm ơn!
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
tiendungnst đã viết:
Option Explicit
Sub BCTK(Folder As String, ShName As String, SrcRng As String, Target As Range)
Dim Temp As String
Temp = ShName & "'!" & Range(SrcRng).Address(, , 2)
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
ActiveWorkbook.Names.Add "Arr", "=""'" & Folder & "[""&Files(""" & Folder & "*.*"")&""]" & Temp & """"
Target.Consolidate Evaluate("Arr"), 9, 0, 1
ActiveWorkbook.Names("Arr").Delete
End Sub
Sub Tonghop()
Dim Folder As String, ShName As String, SrcRng As String
Range("B12:M27").ClearContents
With CreateObject("Shell.Application")
On Error Resume Next
Folder = .BrowseForFolder(0, "", 1).Self.Path
End With
ShName = "MAU1": SrcRng = "B12:M27"
BCTK Folder, ShName, SrcRng, Range("B12")
End Sub

Đoạn CODE trên mình copy được từ các cao thủ của GPE và mình chỉnh sửa lại để phục vụ yêu cầu công việc của mình thấy rất đúng với yêu cầu, nhưng vấn đề còn một tí vướng mắc là File Excel tổng hợp của mình có hơn 10 SHEET và các file dữ liệu cũng chung một mẫu, nhưng đoạn CODE trên chỉ tổng hợp cho một SHEET có tên là "MAU1". Vậy đoạn CODE phải chỉnh sửa như thế nào để tất cả các SHEET trong File có thể tổng hợp dữ liệu từ các SHEET tương ứng của các File nguồn
Nhờ các ACE GPE xem và giúp ah. Xin cảm ơn!
Nhấp chuột vào đây để mở rộng...

Muốn chọn sheet nào thì thay chỗ màu đỏ.
Muốn chọn vùng nào cần tính thì thay chỗ màu xanh.

Range("B12:M27").ClearContents
ShName = "MAU1": SrcRng = "B12:M27"
 
Upvote 0
be09 đã viết:
Muốn chọn sheet nào thì thay chỗ màu đỏ.
Muốn chọn vùng nào cần tính thì thay chỗ màu xanh.

Range("B12:M27").ClearContents
ShName = "MAU1": SrcRng = "B12:M27"
Nhấp chuột vào đây để mở rộng...

Mình đã thử, nhưng nếu chỉ thay chổ màu đỏ thành "MAU2" thì nó chỉ tổng hợp cho SHEET đó, Nhu cầu của mình là muốn tất cả các SHEET có trong File đều được tổng hợp từ các SHEET tương ứng của các file dữ liệu thì phải chỉnh như thế nào ah?
Đã thử như vầy: ShName = "MAU1, MÀU": SrcRng = "B12:M27" và như này: ShName = ("MAU1","MAU2"): SrcRng = "B12:M27" cũng ko được ah!
 
Upvote 0
tiendungnst đã viết:
Mình đã thử, nhưng nếu chỉ thay chổ màu đỏ thành "MAU2" thì nó chỉ tổng hợp cho SHEET đó, Nhu cầu của mình là muốn tất cả các SHEET có trong File đều được tổng hợp từ các SHEET tương ứng của các file dữ liệu thì phải chỉnh như thế nào ah?
Đã thử như vầy: ShName = "MAU1, MÀU": SrcRng = "B12:M27" và như này: ShName = ("MAU1","MAU2"): SrcRng = "B12:M27" cũng ko được ah!
Nhấp chuột vào đây để mở rộng...

Ít ra thì bạn cũng phải đưa lên đây vài file con và 1 file đích, ghi rõ kết quả bạn cần là gì chứ
(hỏi hoài mà chẳng thấy ai trả lời thì... tự biết rồi đấy)
 
Upvote 0
ndu96081631 đã viết:
Ít ra thì bạn cũng phải đưa lên đây vài file con và 1 file đích, ghi rõ kết quả bạn cần là gì chứ
(hỏi hoài mà chẳng thấy ai trả lời thì... tự biết rồi đấy)
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bác đã nhắc nhở, xin rút kinh nghiệm ah! Yêu cầu bài tập của E là CODE để tự tổng hợp dữ liệu của all các File có trong thư mục con ( tất cả các file đều có cùng biểu mẫu)
Vui lòng xem file đính kèm!
 
Lần chỉnh sửa cuối:
Upvote 0
tiendungnst đã viết:
Cảm ơn Bác đã nhắc nhở, xin rút kinh nghiệm ah! Yêu cầu bài tập của E là CODE để tự tổng hợp dữ liệu của all các File có trong thư mục con ( tất cả các file đều có cùng biểu mẫu)
Vui lòng xem file đính kèm!
Nhấp chuột vào đây để mở rộng...

Dữ liệu trong các sheet của bạn nó "loạn cào cào", chẳng theo quy luật nào (Sheet thì có dữ liệu bằng đầu từ dòng 12, sheet khác lại có dữ liệu bắt đầu từ dòng 7... vân vân...)
Vậy biết cách nào tổng hợp đây bạn?
Nếu nó "loạn" như thế thì thôi có bao nhiều sheet ta viết bấy nhiêu sub để tổng hợp từng cái cho chắc
Vậy đi nha
 
Upvote 0
ndu96081631 đã viết:
Dữ liệu trong các sheet của bạn nó "loạn cào cào", chẳng theo quy luật nào (Sheet thì có dữ liệu bằng đầu từ dòng 12, sheet khác lại có dữ liệu bắt đầu từ dòng 7... vân vân...)
Vậy biết cách nào tổng hợp đây bạn?
Nếu nó "loạn" như thế thì thôi có bao nhiều sheet ta viết bấy nhiêu sub để tổng hợp từng cái cho chắc
Vậy đi nha
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bác đã hướng dẫn, Vì ko rành về Excel nên lúc thiết kế mẫu em cũng chưa hình dung ra ah, E đã chỉnh lại các biểu mẫu rồi nhờ Bác xem giúp ah. Hoặc bác có thể chỉnh sửa đoạn CODE theo như yêu cầu của bài tập, còn việc thiết kế lại vùng dữ liệu e sẽ thiết kế lại được ko ah.
E cũng đã thử viết CODE cho từng nút lệnh cho từng SHEET nhưng nó tổng hợp cũng không đúng yêu cầu ah
Em gửi lại File đã chỉnh sửa!
 

File đính kèm

Upvote 0
tiendungnst đã viết:
Cảm ơn Bác đã hướng dẫn, Vì ko rành về Excel nên lúc thiết kế mẫu em cũng chưa hình dung ra ah, E đã chỉnh lại các biểu mẫu rồi nhờ Bác xem giúp ah. Hoặc bác có thể chỉnh sửa đoạn CODE theo như yêu cầu của bài tập, còn việc thiết kế lại vùng dữ liệu e sẽ thiết kế lại được ko ah.
E cũng đã thử viết CODE cho từng nút lệnh cho từng SHEET nhưng nó tổng hợp cũng không đúng yêu cầu ah
Em gửi lại File đã chỉnh sửa!
Nhấp chuột vào đây để mở rộng...

Đã xem file và thấy bạn cũng có chỉnh sửa lại dữ liệu. Tuy nhiên, Sheet MAU6 và MAU7 vẫn còn khác so với những sheet khác
Nếu tất cả các sheet đều giống nhau về cấu trúc thì ta có thể làm vầy:
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  Dim wks As Worksheet
  Range("B12:R27").ClearContents
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:R37"
  [COLOR=#ff0000][B]For Each wks In ThisWorkbook.Worksheets
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, wks.Range("B12")
  Next[/B][/COLOR]
End Sub
Chổ màu đỏ là chổ sửa lại để "mần" hết các sheet
Nhưng nếu dữ liệu vẫn lung tung thế tôi bó tay rồi
(và tin chắc các cao thủ khác cũng khó ai có đủ kiên nhẫn để giúp bạn vụ này)
 
Upvote 0
ndu96081631 đã viết:
Đã xem file và thấy bạn cũng có chỉnh sửa lại dữ liệu. Tuy nhiên, Sheet MAU6 và MAU7 vẫn còn khác so với những sheet khác
Nếu tất cả các sheet đều giống nhau về cấu trúc thì ta có thể làm vầy:
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  Dim wks As Worksheet
  Range("B12:R27").ClearContents
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:R37"
  [COLOR=#ff0000][B]For Each wks In ThisWorkbook.Worksheets
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, wks.Range("B12")
  Next[/B][/COLOR]
End Sub
Chổ màu đỏ là chổ sửa lại để "mần" hết các sheet
Nhưng nếu dữ liệu vẫn lung tung thế tôi bó tay rồi
(và tin chắc các cao thủ khác cũng khó ai có đủ kiên nhẫn để giúp bạn vụ này)
Nhấp chuột vào đây để mở rộng...

Em đã chỉnh sửa CODE theo gợi ý của Bác, nhưng nó không chạy được ah, E đã xóa cả hai SHEET "MAU6" và "MAU7" nhưng nó vẫn không chạy được ah,
Nhờ Bác xem lại giúp, E đã mò thử nhưng không sửa được ah.
E gửi lại File đã xóa 02 SHEET
 

File đính kèm

Upvote 0
tiendungnst đã viết:
Em đã chỉnh sửa CODE theo gợi ý của Bác, nhưng nó không chạy được ah, E đã xóa cả hai SHEET "MAU6" và "MAU7" nhưng nó vẫn không chạy được ah,
Nhờ Bác xem lại giúp, E đã mò thử nhưng không sửa được ah.
E gửi lại File đã xóa 02 SHEET
Nhấp chuột vào đây để mở rộng...

Không chạy là thế nào? Tôi thử bình thường
Nếu có báo lỗi thì chắc là bạn quên khai báo biến wks ở đầu code
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  [COLOR=#ff0000][B]Dim wks As Worksheet[/B][/COLOR]
  Range("B12:M27").ClearContents
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:M27"
  For Each wks In ThisWorkbook.Worksheets
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, wks.Range("B12")
  Next
End Sub
Dòng màu đỏ ấy
-----------
Nói ngoài lề chút: Bạn chèn chi mà cả 1 rừng module thế? (21 module tất cả)
 
Upvote 0
ndu96081631 đã viết:
Không chạy là thế nào? Tôi thử bình thường
Nếu có báo lỗi thì chắc là bạn quên khai báo biến wks ở đầu code
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  [COLOR=#ff0000][B]Dim wks As Worksheet[/B][/COLOR]
  Range("B12:M27").ClearContents
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:M27"
  For Each wks In ThisWorkbook.Worksheets
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, wks.Range("B12")
  Next
End Sub
Dòng màu đỏ ấy
-----------
Nói ngoài lề chút: Bạn chèn chi mà cả 1 rừng module thế? (21 module tất cả)
Nhấp chuột vào đây để mở rộng...

E đã sửa CODE, nhưng nó vẫn chỉ tổng hợp được có một SHEET "MAU1" nhưng dòng đầu tiên (Row12) chạy ko đúng, còn các SHEET khác ko tổng hợp được ah. E đã chuyển tất cả các File về cùng một cấu trúc nhưng vẫn ko chạy được,
Nhờ bác xem lại giúp, e gửi lại file có cùng cấu trúc cho tất cả.
 

File đính kèm

Upvote 0
tiendungnst đã viết:
E đã sửa CODE, nhưng nó vẫn chỉ tổng hợp được có một SHEET "MAU1" nhưng dòng đầu tiên (Row12) chạy ko đúng, còn các SHEET khác ko tổng hợp được ah. E đã chuyển tất cả các File về cùng một cấu trúc nhưng vẫn ko chạy được,
Nhờ bác xem lại giúp, e gửi lại file có cùng cấu trúc cho tất cả.
Nhấp chuột vào đây để mở rộng...

Tại bạn copy code sai thôi
Code tôi ghi rõ thế này:
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  Dim wks As Worksheet
  Range("B12:M27").ClearContents
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:M27"
  For Each wks In ThisWorkbook.Worksheets
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, [SIZE=4][COLOR=#ff0000][B]wks.[/B][/COLOR][/SIZE]Range("B12")
  Next
End Sub
Chổ màu đỏ của tôi bạn bỏ đâu mất rồi
???
------------
Ngoài ra, nếu các sheet đích đang chưa dữ liệu thì phải Clear từng sheet trước khi tổng hợp:
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  Dim wks As Worksheet
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:M27"
  For Each wks In ThisWorkbook.Worksheets
    [COLOR=#ff0000]wks.Range("B12:M27").ClearContents[/COLOR]
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, wks.Range("B12")
  Next
End Sub
Chán bạn quá, chỉ có mỗi việc copy code paste vào cũng sai! Tôi cho file lên luôn đây
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Tại bạn copy code sai thôi
Code tôi ghi rõ thế này:
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  Dim wks As Worksheet
  Range("B12:M27").ClearContents
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:M27"
  For Each wks In ThisWorkbook.Worksheets
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, [SIZE=4][COLOR=#ff0000][B]wks.[/B][/COLOR][/SIZE]Range("B12")
  Next
End Sub
Chổ màu đỏ của tôi bạn bỏ đâu mất rồi
???
------------
Ngoài ra, nếu các sheet đích đang chưa dữ liệu thì phải Clear từng sheet trước khi tổng hợp:
Mã: 
Sub Tonghop()
  Dim Folder As String, ShName As String, SrcRng As String
  Dim wks As Worksheet
  With CreateObject("Shell.Application")
    On Error Resume Next
    Folder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  SrcRng = "B12:M27"
  For Each wks In ThisWorkbook.Worksheets
    [COLOR=#ff0000]wks.Range("B12:M27").ClearContents[/COLOR]
    ShName = wks.Name
    BCTK Folder, ShName, SrcRng, wks.Range("B12")
  Next
End Sub
Chán bạn quá, chỉ có mỗi việc copy code paste vào cũng sai! Tôi cho file lên luôn đây
Nhấp chuột vào đây để mở rộng...

Cảm ơn Bác nhiều lắm, mọi thứ đều OK, tại e gà quá nên phiền Bác nhiều, Cảm ơn Bác lần nữa nhé, ôi Vui quá!
+-+-+-+ ;;;;;;;;;;; @$@!^% &&&%$R --=0!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

M
  • Question Question
[Hỏi cách tạo VBA] - Xin các cao nhân chỉ giúp cách tạo VBA cho công việc thuận tiện hơn (1 người xem)
Trả lời
2
Đọc
35
manhcuonghg
M
S
cần xử lý dữ liệu trùng nhau bằng VBA
    • Cười
Trả lời
6
Đọc
131
sonminhtran
S
N
Tạo file lưu trữ dữ liệu tự động trên excel. (1 người xem)
Trả lời
10
Đọc
150
nguyenle01
N
D
lọc các ô trong một cột chứa một nhóm dữ liệu? mong các cao thủ giải đáp giúp mình
Trả lời
3
Đọc
44
Gà Con yêu VBA
Gà Con yêu VBA
N
  • Question Question
Tạo file lưu trữ dự liệu tự động (1 người xem)
Trả lời
7
Đọc
156
nguyenle01
N
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
7
Đọc
314
Gà Con yêu VBA
Gà Con yêu VBA
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
519
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
3
Đọc
140
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ (1 người xem)
Trả lời
4
Đọc
105
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
85
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
81
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL (1 người xem)
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
621
Quang_Hải
Quang_Hải
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom