Giải pháp nào để tăng tốc độ cho bảng tính. (2 người xem)

[kieuhuy_bmt]

Kính gửi các anh chị trên GPE.
Thú thực là kiến thức EXCEL của em chả có gì nên kg đóng góp gì đc cho GPE. Em đã nhiều lần nhờ quá (những bài gần đây chẳng thấy ai thèm đọc, thấy buồn ghê!) Tuy nhiên vì công việc lần này em lại nhờ các bác giúp một tay. Nhờ mọi người có giải pháp nào giúp cho cái tốc độ xử lý nhanh (Trong các bảng Tổng hợp.- trong File gửi kèm.) Mong mọi người (anh em quản lý đất đai, đo đạc bản đồ ) giúp đỡ.

 

[SA_DQ]

15 giây để tính cho 1 trang bằng hàm DSUM() có sự trợ giúp từ VBA

Bạn kiểm theo file nha;

& mình chưa rõ các trang còn lại tính cái chi rứa?

http://www.mediafire.com/?ygir6dnrunn7n4c

 

[kieuhuy_bmt]

Bạn kiểm theo file nha;

& mình chưa rõ các trang còn lại tính cái chi rứa?

Cảm ơn bạn SA_DQ : Vừa rồi bạn tổng hợp xong lớp "diện tích" gắn với từng loại "ruộng đất" theo "mảnh bản đồ". Nếu bạn để ý, thì thấy trang kế tiếp mình muốn đếm theo lớp "số thửa đất". Ở 2 trang cuối thay vì theo "mảnh bản đồ" bạn tổng hợp giúp theo "thôn".
Bạn có thể kiểm tra lại cái Code vì mình mơí kiểm tra tổng diện tích của mảnh DC1 thấy sai (tăng gấp nhiều lần).
Ngoài ra, nếu có thể bạn hướng dẫn cụ thể hơn để mình tự sửa đuợc cái Code (làm sao để thêm cột, thêm hàng) nhé. Rất cảm ơn bạn đã bớt chút thời gian giúp mình.

 

[SA_DQ]

Cái vụ sai lớn nhiều lần này cũng tại BG ẻm bùa các kí tự đại diện đó bạn,hi, hi ...

Trong macro có xài hàm DSUM() của excel; mà fần chuẩn để tra là 'mãnh bản đồ' lại chưa chuẩn theo ông BG này iêu cầu, nên sai;

Bây chừ & về sau bạn đổi hết các mã này như bản dưới đây:

Mã cũ| Đổi thành
DC1|DC001
DC2|DC002
...|...
DC9|DC009
DC10|DC010
DC11|DC011
... |...
DC19|DC019
DC20|DC020

(Vì Mã lớn nhứt của bạn đang là [DC136] nên tạm đổi như vậy để kiểm tra chương trình trước đã; Nhưng sau đó nên chuyển hết về dang DCxxx để sau này ngon giấc khi ngủ!
Bạn sửa ên nha & báo kết quả đã đúng, lúc đó chúng ta sẽ tiếp các fần còn lại của các vấn đề của bạn

Thân ái!

 

[concogia]

Kính gửi các anh chị trên GPE. Thú thực là kiến thức EXCEL của em chả có gì nên kg đóng góp gì đc cho GPE. Em đã nhiều lần nhờ quá (những bài gần đây chẳng thấy ai thèm đọc, thấy buồn ghê!) Tuy nhiên vì công việc lần này em lại nhờ các bác giúp một tay. Nhờ mọi người có giải pháp nào giúp cho cái tốc độ xử lý nhanh (Trong các bảng Tổng hợp.- trong File gửi kèm.)Mong mọi người giúp đỡ.

Hãy giải thích TONG_2, TONG_3, TONG_4 tính cái quái gì ?, nhìn công thức chẳng hiểu gì ráo. (Đất gì mà lắm loại đất thế)
Cứ thêm dữ liệu rồi chọn sheet TONG_1 kiểm tra kết quả xem sao
Thân

 

[kieuhuy_bmt]

Hãy giải thích TONG_2, TONG_3, TONG_4 tính cái quái gì ?, nhìn công thức chẳng hiểu gì ráo. (Đất gì mà lắm loại đất thế)
Cứ thêm dữ liệu rồi chọn sheet TONG_1 kiểm tra kết quả xem sao
Thân

Lại gặp bác CCG (con cò già). Cảm ơn bác nhiều lắm dù sao có người đọc bài là mừng rồi, đằng này Bác góp tý công sức để tôi hoàn thành cái món kia. Vậy nợ tất cả các bác 1 chầu cà phê Trung nguyên tại Buôn Ma Thuột. Thực ra là tôi làm giúp anh em trong cơ quan, bản thân làm hành chính, thấy excel hẫp dẫn nên Pos lên nhờ lại các bác cho anh em làm đỡ khổ. Xin nhắc lại, tôi ở Buôn Ma Thuột "Buồn Muôn Thủa", các Bác có đi Bản Đôn xem voi... đến Ngã 6 Alô cho tôi nhé! mời đi uống Cà phê thôi (Bữa trước đi uống ca phê với mấy anh em Sài gòn - cùng với JeNi!
Gửi lại Bác cái File, Bác xem giúp nhé, "có voi đòi tiên" trong File tôi nhờ Bác nhiều lắm.

 

[concogia]

Lại gặp bác CCG (con cò già). Cảm ơn bác nhiều lắm dù sao có người đọc bài là mừng rồi, đằng này Bác góp tý công sức để tôi hoàn thành cái món kia. Vậy nợ tất cả các bác 1 chầu cà phê Trung nguyên tại Buôn Ma Thuột. Thực ra là tôi làm giúp anh em trong cơ quan, bản thân làm hành chính, thấy excel hẫp dẫn nên Pos lên nhờ lại các bác cho anh em làm đỡ khổ. Xin nhắc lại, tôi ở Buôn Ma Thuột "Buồn Muôn Thủa", các Bác có đi Bản Đôn xem voi... đến Ngã 6 Alô cho tôi nhé! mời đi uống Cà phê thôi (Bữa trước đi uống ca phê với mấy anh em Sài gòn - cùng với JeNi!
Gửi lại Bác cái File, Bác xem giúp nhé, "có voi đòi tiên" trong File tôi nhờ Bác nhiều lắm.

1- Bạn cứ thêm Mã Bản Đồ....các loại đi, máy hiểu hết mà, mình thử thêm cả trăm thằng "DC.." máy chơi láng
2- TONG_2 vẫn chưa hiểu, đơn vị tính =Thửa ra làm sao ???, nhập thử vài kết quả bằng tay xem mặt mũi nó thế nào
3- TONG_3 tổng hợp theo Thôn, đơn vị là Thửa:
*Thôn có lèo tèo vài thôn thì thống kê quái gì
*Thửa thì vẫn "đếch hiểu"
Bạn gởi lại file, Sheet TONG_2 nhập một ít kết quả, sheet TONG_3 thêm vài ngàn thôn (thống kê mới đã), nhập vài kết quả
Thấy dữ liệu mấy chục ngàn dòng mới làm chứ tí tẹo mà thống kê thì ...chán lắm
Bi giờ đâu ai "Có voi đòi tiên" vì tiên chỉ có trong truyện cổ tích, cũg chẳng ai "có voi đòi Hai Bà Trưng" vì Hai Bà Trưng mất lâu rồi mà người ta chỉ:
"Có voi đòi một gói thuốc ngâm rươu A Ma Kông"
Thân

 

[kieuhuy_bmt]

......
2- TONG_2 vẫn chưa hiểu, đơn vị tính =Thửa ra làm sao ???, nhập thử vài kết quả bằng tay xem mặt mũi nó thế nào
........
*Thửa thì vẫn "đếch hiểu"

Cảm ơn bác ! Mấy hôm nay lu bu quá họp hành, linh tinh nên giờ mới ghé. Mình gửi lại cái File Bác xem giùm nhé.
Số DĐ của mình là: 0903 576 874, khi nào đi ngang BMT gọi mình nhé.

 

[concogia]

Cảm ơn bác ! Mấy hôm nay lu bu quá họp hành, linh tinh nên giờ mới ghé. Mình gửi lại cái File Bác xem giùm nhé.
Số DĐ của mình là: 0903 576 874, khi nào đi ngang BMT gọi mình nhé.

Trong sheet TONG_4 bạn có ghi:

Làm sao để máy tự động nhập dữ liệu ở đây (A8 đến hết và từ B8 đến X8 vv..)

Từ A8 đến hết thì hiểu, cái này OK
Từ B8 đến X8 nhưng cái mũi tên chỉ dòng số 7 vậy, có phải bạn muốn khi thêm loại đất NHK, LNC ... thì tư B7 trở qua bên phải tự động điền thêm loại đất không ??? , nếu đúng thế thì phải sửa lại tý tẹo, còn không phải có thể bài này thỏa các yêu cầu của bài
Bạn cứ thêm dữ liệu đi, máy sẽ hiểu và lọc
Bạn kiểm tra giúp, có gì chưa đúng mình lại tiếp tục "zật lộn zí nó"

Số DĐ của mình là: 0903 576 874, khi nào đi ngang BMT gọi mình nhé

Híc, BMT có thể là Buồn Muốn...Tèo, mình hổng ghé đâu, bạn mời Jeni ca-phe thế mình nhé
Thân

 

[kieuhuy_bmt]

Gửi CCG cái File của anh em trên GPE "Xin lỗi tác giả-lâu rồi nên quên tên" để Bác tham khảo.

 

[sealand]

Mình làm tranh thủ nên chưa test kỹ.
Dữ liệu lớn nên dùng mảng và Dictionary nên tốc độ cũng ổn, bạn tham khảo.

http://www.mediafire.com/?jymo6j1ksgexjto

 

[kieuhuy_bmt]

Từ B8 đến X8 nhưng cái mũi tên chỉ dòng số 7 vậy, có phải bạn muốn khi thêm loại đất NHK, LNC ... thì tư B7 trở qua bên phải tự động điền thêm loại đất không ??? , nếu đúng thế thì phải sửa lại

Chỗ này do mình để cái mũi tên, thực ra cái mũi tên ấy diễn tả cho cả hàng. Nghĩa là ở bên DATA ta thêm một mã đất lạ "ZZZ" chẳng hạn máy chịu bó tay. Bạn "zật lộn" thêm tý nhé.

Híc, BMT có thể là Buồn Muốn...Tèo, mình hổng ghé đâu, bạn mời Jeni ca-phe thế mình nhé
Thân

He,he món này không hiểu.

 

[kieuhuy_bmt]

Mình làm tranh thủ nên chưa test kỹ.

1.Cảm ơn bạn nhiều lắm! Món VBA mình kg biết tý gì, món "Dictionary" càng mù tịt, tóm lại là chuyên đi xài ké.
Mình chạy File có cái nút.. Bấm sướng ghê, và nói chung chạy ổn, bạn thêm giúp mình mấy cái thủ tục làm sao khi ta thêm một mã mới (mã mới bất kỳ ở cột nào, dòng nào" kg trùng mã cũ") ở DATA, máy tự động lập bảng và có thể xếp theo một trật tự nào đó.
2. mình đính chính lại là: trong bảng tổng hợp ở hàng thứ 6 "nhóm đất" có thể bỏ đi, kg cần dùng.
Các bạn xử lý giúp với nhé.

 

[sealand]

Theo mình bạn nên lập 1 bảng danh mục loại đất để bảo dảm mã chính xác tránh gõ nhầm. Khi nhập bạn chọn trong List. Khi thêm bạn có thể sử dụng hàm Countif để kiểm tra nếu trong List>1 là mã đó bị trùng.
Với yêu cầu này thì phải chỉnh sửa Code 1 chút và chọn lọc những loại mã nào không có số liệu thì cũng loại ra để báo cáo gọn gàng.
Riêng bạn nói bỏ dòng 6 là sao. Nếu vậy biết loại nào với loại nào

 

[kieuhuy_bmt]

Theo mình bạn nên lập 1 bảng danh mục loại đất để bảo dảm mã chính xác tránh gõ nhầm. Khi nhập bạn chọn trong List. Khi thêm bạn có thể sử dụng hàm Countif để kiểm tra nếu trong List>1 là mã đó bị trùng.

1.Ý minh là trong DATA nhập thêm mã mới, bên sheet tổng hợp máy tự động thêm vào cũng giống như thêm mã "mảnh bản đồ" mà Bác CCG đã làm, máy chạy tốt. Việc kiểm tra có trùng hay kg chưa bàn đến.

Riêng bạn nói bỏ dòng 6 là sao. Nếu vậy biết loại nào với loại nào

2. Chỗ này ý mình là: ở bên sheet tổng hợp có dòng nhóm đất nằm trên dòng mã đất, bỏ dòng nhóm đất đi vì nếu để... thì các Bác mất nhiều thời giờ hơn.
Mình gửi lại cái File

 

[kieuhuy_bmt]

Bác CCG thông cảm! vừa rồi có thêm bác Sealand giúp, nhưng mà dự án vẫn dở dang, chưa xong. Vậy các Bác tiếp tục giúp tôi với.

 

[sealand]

Sơ bộ điều chỉnh lại, hoàn toàn tự động thống kê thôn,tờ bản đồ, loại đất (bạn có thể kiểm tra bằng thêm 1 loại đất nào đó hoặc sửa 1 dòng nào đó). Mình kết hợp 2 dictionary và bỏ bớt vòng lặp nên tốc độ tăng lên đáng kể. (Loanh quanh mất gần buổi chiều rồi)
Bạn điều chỉnh lại theo ý mình nha. Lưu ý từ dòng 5 là của code tự chạy. Phần tiêu đề bạn được sử dung 4 dòng đầu.

Ban tải theo link sau:

http://www.mediafire.com/?abds5bijcdyo4r9

 

[kieuhuy_bmt]

Sơ bộ điều chỉnh lại, hoàn toàn tự động thống kê thôn,tờ bản đồ, loại đất ...(bạn có thể kiểm tra bằng thêm 1 loại đất nào đó hoặc sửa 1 dòng nào đó).

Theo yêu cầu của minh công việc đến đây đã hoàn tất (anh em trong cơ quan đỡ phải dùng sumduruc ..rùa bò nữa). Thay mặt anh em mình cảm ơn bạn nhiều nhiều.
Tuy còn một yêu cầu nhỏ mình nghĩ là bạn sẽ giúp. Đó là hướng dẫn minh làm sao để mình tự tạo được cái bảng " tổng hợp theo người đo, năm đo, tỷ lệ bản đồ.."
Mình gửi mẫu kèm File ở sheet đầu tiên và ghi chú 1 vài lỗi nhỏ ở các Sheet tổng hợp.
Cảm ơn và hẹn gặp lại các bác.

 

[sealand]

Bạn phải biết code 1 chút sẽ đơn giản hơn nhiều. banj để ý code của mình có 1 số điểm lưu ý khi:
-Cột nào muốn tập hợp cho tiêu đề dòng tại cột 1 thì nạp cho Dic1, cột nào muốn tập hợp cho tiêu đề cột trên dòng 5 thì nạp cho Dic2.
-Nếu muốn cộng dồn thì cộng với mảng Kq với giá trị cột đó. Nếu muốn đếm thì cộng với 1

Mà thôi, bạn nói hạn chế code thì cũng khó. Mình giúp cho trót.

http://www.mediafire.com/?4zreqegb6c3w63l

 

[kieuhuy_bmt]

Bạn phải biết code 1 chút sẽ đơn giản hơn nhiều. banj để ý code của mình có 1 số điểm lưu ý khi:
-Cột nào muốn tập hợp cho tiêu đề dòng tại cột 1 thì nạp cho Dic1, cột nào muốn tập hợp cho tiêu đề cột trên dòng 5 thì nạp cho Dic2.

Mình xem các bảng tổng hợp chưa phát hiện ra chỗ Dc1 và Dc2 code khác nhau giữa các bảng.

-.............Mà thôi, bạn nói hạn chế code thì cũng khó. Mình giúp cho trót.

Mình copy và so sánh giữa những code có những điểm khác nhau và giống nhau, thấy ham quá.. copy sang File khác để chạy thử (Alt+F8) thì máy báo lỗi lung tung. Mình biết muốn chạy được là cả một quá trình thức khuya..dậy sớm, thậm chí đầu tư chút chút có phải kg các bác. Thú thực là có mua 1 quyển sách VBA của anh Tử Hướng về đọc, xong mới đc mấy trang là oải rùi (3 năm nay kg rờ tới nó), xem ra kg phải việc của mình. Các bác giúp tôi với, xem giúp cái FILE kèm và giải thích giùm, nếu mát tay có khi anh em trong cơ quan đc nhờ vì còn nhiều việc phải làm lắm.
Chân thành cảm ơn các Bác.

 

[sealand]

Cái mà bạn nói là nó chạy lung tung đó bạn lưu ý 1 chút sẽ trật tự răm rắp thôi. Trong mỗi đoạn Code có mấy cái chỗ này bạn phải lưu ý:
-Data phải bắt đầu từ dòng 4 không tính dòng tiêu đề. Muốn khác đi bạn phải sửa đoạn code sau:

Tm = Sheet10.Range(Sheet10.[A4], Sheet10.[F65536].End(3))

-Tại file của bạn sheet Data có NameCode là Sheet10 (Bạn thấy nó trên Explore trong VBA) sang file mới bạn phải sửa cho phù hợp.

Tm = Sheet10.Range(Sheet10.[A4], Sheet10.[F65536].End(3))

-Bạn lưu ý Sheet THBCao đều xác định theo NameCode của nó. Bạn chú ý 2 dòng:
...............
Sheet3.[A5:AP1000].ClearContents -------Xoá dữ liệu sheet báo cáo từ dòng 5 đến dòng 1000
...............
With Sheet3 --------Nhập dữ liệu kết quả vào sheet báo cáo
.[A5] = "Thon"
.[B5].Resize(, Dc2.Count).Value = b
.[B5].Offset(, Dc2.Count).Value = "Cong"
.[A6].Resize(Dc1.Count).Value = WorksheetFunction.Transpose(a)
.[A6].Offset(Dc1.Count).Value = "Cong :"
.[B6].Resize(UBound(Kq1, 1), UBound(Kq1, 2)) = Kq1
End With
(Phần chữ đỏ không đậm xác dịnh dòng bắt đầu của báo cáo do code tự điền)

Bạn lưu ý các điểm trên là có thể không cho Code chạy lung tung được.


Còn Dc1, Dc2 nó là 2 cái Dictionary mà, cái khác nhau giữa các Sheet là cột dữ liệu mình đưa vào nhờ Dictionary tổng hợp mà thôi. Chỗ chữ đỏ dòng sau là xác định cột đưa vào

..........
If Not Dc1.exists(Tm(i, 6)) Then
n1 = n1 + 1
Dc1.Add Tm(i, 6), n1
If Not Dc2.exists(Tm(i, 4)) Then
n2 = n2 + 1
Dc2.Add Tm(i, 4), n2
ReDim Preserve Kq(1 To UBound(Tm, 1), 1 To n2)

...........


Bạn yêu nó, cố gắng 1 chút là được vì đây là những kỹ thuật sơ đẳng nhất mà lại có ích cho công việc của chúng ta.
Nói để bạn thấy rằng bạn sẽ làm được, mình hoàn toàn chưa được học bất kỳ 1 lớp tin học nào. Tự nghiên cứu và gần đây với sự trợ giúp của GPE mình cũng tích lũy 1 số kiên thức và giờ có thể giúp bạn.
Chúc bạn thành công.

 

[kieuhuy_bmt]

Nói để bạn thấy rằng bạn sẽ làm được, mình hoàn toàn chưa được học bất kỳ 1 lớp tin học nào. Tự nghiên cứu và gần đây với sự trợ giúp của GPE mình cũng tích lũy 1 số kiên thức và giờ có thể giúp bạn.
Chúc bạn thành công.

Nhờ sự động viên mạnh mẽ của bạn nên mình đã hiểu đc phần nào. Cảm ơn bạn..Tuy nhiên nếu có người hỏi thì mình chịu bó tay, kg giải thích bằng ngôn ngữ tin học đc. Mình gửi các Bác cái File nhờ xử lý vấn đề tiếp theo.
Nói sơ qua cái vụ tô viền, kẻ dòng.. luôn với nhé, hình như là dùng CF....
Các bác có bận gì thì.. thi thoảng vô xem để mình nhờ với nhé! Chào mọi người.

 

[sealand]

Tô kẻ dùng Condition Format. Bạn tìm hiểu thêm.
Để những ô còn trống chuyển thành chưa có tên bạn thêm dòng màu đỏ như sau:

........................................
Set Dc1 = CreateObject("scripting.dictionary")
Set Dc2 = CreateObject("scripting.dictionary")
For i = 1 To UBound(Tm, 1)
[COLOR=#ff0000]If Trim(Tm(i, 5)) = "" Then Tm(i, 5) = "Chua co ten"[/COLOR]
If Not Dc1.exists(Tm(i, 5)) Then
n1 = n1 + 1
Dc1.Add Tm(i, 5), n1
.............................................................

Bạn nói còn lơ mơ VBA mà đã dần chỉnh Code theo ý mình và dữ liệu mới rồi. Như vậy là quá nhanh rồi.

 

[kieuhuy_bmt]

Tô kẻ dùng Condition Format. Bạn tìm hiểu thêm.

Dùng code có nặng file kg bạn, nếu được chỉ cho mình với, trên diễn đàn có nhiều trang nói về việc này nhưng mình kg biết lồng vào thế nào.

Để những ô còn trống chuyển thành chưa có tên bạn thêm dòng màu đỏ như sau:

Chạy tốt rồi, nhưng giữ có dấu tiếng việt chắc là phải có mẹo khác phải kg?

Bạn nói còn lơ mơ VBA mà đã dần chỉnh Code theo ý mình và dữ liệu mới rồi. Như vậy là quá nhanh rồi.

Hồi đi thi vi tính thấy mấy em học sinh cấp 1-2 viết lệnh trên DOS "màn hình xanh xanh" nhanh thoăn thoắt, máy chạy êm, còn phát ra cả nhạc..mình nghĩ công nghệ phần mềm Việt Nam sẽ còn phát triển. Với mình thời kỳ bao cấp cha mẹ cho học hết phổ thông đã là khủng rồi, hơn khối người thời kỳ ấy. Phải bỏ qua thời kỳ quá độ, bây giờ thấy tiếc, phải học mót thôi.

Bữa trước có đưa lên nhờ ..mọi người mấy chỗ liên quan đến công việc cơ quan, nhưng không hiểu sao kg được ai đọc, thấy chán. Với cái vụ mình nhờ mọi người ở trang này, có các Bác quan tâm nên thấy nhẹ nhõm trong lòng.
Đích cuối cùng của việc này ý mình là đưa những cái lệnh đó lên thanh Rinbon "phía trên màn hình gì đó" làm sao giống như một Add-in cài để xài các máy khác. Mình nghĩ ngành quản lý đất đai, hiện nay đã có phần mềm, tuy nhiên những tiện ích kèm sau phần mềm hiện nay chưa thấy hỗ trợ việc tổng hợp nhiều chiều như cái code bạn giúp. Vì vậy kết quả bạn giúp chắc chắn sẽ có nhiều người dùng.
Cảm ơn nhiều, bạn sẽ giúp mình nhé.

 

[kieuhuy_bmt]

Mình làm mọi người phật ý rồi..

 

[sealand]

Đây là hàm tạo chuỗi mã VBA tiếng Việt có dấu.
Ví dụ ô A1 gõ "Chưa có tên."
ô B1 nhập hàm: =VBAUni(A1)
Ta được chuỗi:


"Ch" & ChrW(432) & "a có tên"

Bạn chép đoạn này thay vào chuỗi "Chua co ten." trong code là được

Function VBAUni(chuoi As String) As String
Dim n, Uni1, Uni2
If chuoi = "" Then
VBAUni = ""
Else
chuoi = chuoi & " "
If AscW(Left(chuoi, 1)) < 256 Then VBAUni = """"
For n = 1 To Len(chuoi) - 1
Uni1 = Mid(chuoi, n, 1)
Uni2 = AscW(Mid(chuoi, n + 1, 1))
If AscW(Uni1) > 255 And Uni2 > 255 Then
VBAUni = VBAUni & "ChrW(" & AscW(Uni1) & ") & "
ElseIf AscW(Uni1) > 255 And Uni2 < 256 Then
VBAUni = VBAUni & "ChrW(" & AscW(Uni1) & ") & """
ElseIf AscW(Uni1) < 256 And Uni2 > 255 Then
VBAUni = VBAUni & Uni1 & """ & "
Else
VBAUni = VBAUni & Uni1
End If
Next
If Right(VBAUni, 4) = " & """ Then
VBAUni = Mid(VBAUni, 1, Len(VBAUni) - 4)
Else
VBAUni = VBAUni & """"
End If
End If
End Function

 

[kieuhuy_bmt]

cảm ơn Cealand : Mình thử mãi mà kg đc! (cả ở ví dụ và thay vào code)...đang nghiên cứu..

 

[sealand]

cảm ơn Cealand : Mình thử mãi mà kg đc! (cả ở ví dụ và thay vào code)...đang nghiên cứu..

Thành thực xin lỗi Kieu Huy vì mình không xem kỹ bài.
Tất cả các bài viết mình đều sử dụng mã Unicode để đảm bảo tính phổ dụng cao. Nay xem lại file THUCHANH của Kieu Huy mới biết bạn sử dụng Font TCVN3.
Nếu là Font TCVN3 ta làm như sau:

Trên cửa sổ soạn Code ta cứ gõ tiếng Việt bình thường. Ví dụ gõ "Chưa có tên" ta được

If Trim(Tm(i, 5)) = "" Then Tm(i, 5) = "Ch­a cã tªn."

Trong Code nó loằng ngoằng kệ nó nhưng khi chạy Code nó sẽ trả về Tiếng Việt ngon lành trên sheet Kết quả.
Bạn thử lại xem sao

 

[kieuhuy_bmt]

Thành thực xin lỗi Kieu Huy vì mình không xem kỹ bài.
Tất cả các bài viết mình đều sử dụng mã Unicode để đảm bảo tính phổ dụng cao. Nay xem lại file THUCHANH của Kieu Huy mới biết bạn sử dụng Font TCVN3.
Nếu là Font TCVN3 ta làm như sau:

Trên cửa sổ soạn Code ta cứ gõ tiếng Việt bình thường. Ví dụ gõ "Chưa có tên" ta được

If Trim(Tm(i, 5)) = "" Then Tm(i, 5) = "Ch­a cã tªn."

Trong Code nó loằng ngoằng kệ nó nhưng khi chạy Code nó sẽ trả về Tiếng Việt ngon lành trên sheet Kết quả.
Bạn thử lại xem sao

Cảm ơn sealand.
Về cái Fon, ở Sheet DATA của mình do phần mềm bản đồ nó xuất ra "mặc định cái Fon này" vì vậy mình để nguyên kg sửa.
Trong cái code mình cũng quên "sao kg gõ thẳng có dấu vào Code". do bạn gõ kg dấu... nên mình nghĩ do ngôn ngữ chuẩn của VBA như thế. Bây giờ mình đã sửa theo hướng dẫn của bạn, chạy tốt rồi.
Bạn giúp mình đưa luôn cái Boder vào Code với! anh em bên cơ quan mình kg quen dùng CF.
Mình gửi lại cái File
http://www.mediafire.com/download.php?c82qel8y2wbgxuo

 

[sealand]

Đây là Code kẻ ô, bạn có thể để riêng từng công đoạn hay gọi nó khi kết thúc công đoạn Tổng hợp số liệu

Sub FormatRep()
Dim Rng As Range, i
Set Rng = Sheet2.Range(Sheet2.[A5], Sheet2.[A5].End(2).End(4))
With Rng
    For i = 1 To 4
        .Borders(i).LineStyle = xlContinuous
        .Borders(i).Weight = xlThin
        .Borders(i).ColorIndex = 11
    Next
 End With
 Set Rng = Union(Rng.Rows(1), Rng.Rows(Rng.Rows.Count))
 With Rng
    .Interior.ColorIndex = 42
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .Font.ColorIndex = 36
    .Font.Bold = True
 End With
Set Rng = Nothing
End Sub

 

[TrungChinhs]

@ sealand Tôi nghĩ kẻ bảng thì không cần dùng đến vòng lặp

Vì vậy đoạn

With Rng
     For i = 1 To 4
         .Borders(i).LineStyle = xlContinuous
         .Borders(i).Weight = xlThin
         .Borders(i).ColorIndex = 11
     Next
End With

có thể sửa thành

With Rng
    .Borders.LineStyle = 1
    .Borders.ColorIndex = 11
End With

 

[sealand]

Thực ra, mình đưa vấn đề này vào cũng có vấn đề theo sau nữa, tức là khai báo mảng giá trị cho các loại đường kẻ và màu kẻ. Một mai muốn kẻ khung bao kép, cột đơn, dòng dot thì sao. Tức là chủ động kẻ khung ấy.

 

[kieuhuy_bmt]

Cảm ơn các bác:
*Bây giờ gắn cái code xóa border vào chung với cái sub xóa bảng thì làm sao! Mình ghi đc đoạn mã sau.., dài quá dút gọn thế nào?:

Sub Xoa_Borde()
'
' Xoa_Borde Macro
'


'
    Cells.Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

*Các bác giúp bổ sung đoạn mã xử lý thêm cái yêu cầu nhỏ "yêu cầu nằm trong DATA" Vì chỗ đó liên quan đến sự đấy đủ của sản phẩm..., anh em cần phải bổ sung.
(Trình bày hơi lộn xộn tý nha.."File ảnh cho câu trên, File nén cho câu dưới"):

 

[sealand]

Bạn không để ý rồi, đoạn xoá border đã có rồi mà.
Nó ở đây này:

Sub Thop03()
Dim Dc1, Dc2, i, j, n1, n2
Dim Tm, Kq(), Kq1(), Tg1, Tg2(), a, b
Application.ScreenUpdating = False
[SIZE=4][B][COLOR=#ff0000]Sheet2.[A5:AP1000].Clear[/COLOR][/B][/SIZE]    '<<Trước là:  Sheet2.[A5:AP1000].ClearContents---Có nghĩa là chỉ xoá nội dung>>

Tm = Sheet3.Range(Sheet3.[A4], Sheet3.[F65536].End(3))

...............

 

[kieuhuy_bmt]

Mình ỉ lại quá !đúng là chỉ bỏ cái thằng "ClearContents"
trong cái này "Sheet2.[A5:AP1000].ClearContents" là xong

 

[kieuhuy_bmt]

Gửi bác Sealand ở bài mục 33 Nhờ các bác tiếp tục giúp với.

 

[sealand]

Ít nhất hai từ có nghĩa trong tên ít nhất phải có 1 khoảng Space .Bạn thêm dòng màu đỏ như sau:

.................................................
For i = 1 To UBound(Tm, 1)
If Trim(Tm(i, 5)) = "" Then Tm(i, 5) = "Ch­a cã tªn"
If InStr(1, Tm(i, 5), " ") = 0 Then Tm(i, 5) = Tm(i, 5) & " (Tªn ch­a ®Çy ®ñ.)"
If Not Dc1.exists(Tm(i, 5)) Then
...................................................................

Như vậy dòng nào tên chưa đầy đủ sẽ thêm phần ghi chú ví dụ: Chỉnh (Tên chưa đầy đủ)

 

[kieuhuy_bmt]

Hay quá. Dữ liệu trong DATA còn nhiều vấn đề phải xử lý lắm:
- Do việc định nghĩa tên của mình chưa rõ nên khi lọc chưa hết ví dụ : Nguyễn Nam là một là tên đầy đủ, tuy nhiên "Ông Nam", "Hùng(Thọ)" đây là tên chưa đây đủ, máy không lọc được. Làm thế nào đây.
- Tên đơn "Nam" hoặc "Chỉnh"; ký tự ".." hay ô trống " " là những chỗ cần thông báo "Tên chưa đầy đủ" vv.. Theo đoạn mã Bạn cho có vẻ máy chưa xử lý hết.
Bạn xem giúp mình với.

 

[sealand]

Đúng ra câu lệnh phải thế này nhưng lúc đó mình không kiểm tra

If InStr(1, Trim(Tm(i, 5)), " ") = 0 Then Tm(i, 5) = Tm(i, 5) & " (Tªn ch­a ®Çy ®ñ.)"

Ngoài ra, bạn nên tham khảo danh sách hộ tịch của địa phương. Dùng Code cũng khó vì người Việt có thể đạt tên bằng họ.

 

[kieuhuy_bmt]

@ sealand Tôi nghĩ kẻ bảng thì không cần dùng đến vòng lặp

Vì vậy đoạn

With Rng
     For i = 1 To 4
         .Borders(i).LineStyle = xlContinuous
         .Borders(i).Weight = xlThin
         .Borders(i).ColorIndex = 11
     Next
End With

có thể sửa thành

With Rng
    .Borders.LineStyle = 1
    .Borders.ColorIndex = 11
End With

Gửi bạn TrungChinhs đúng như lời sealand nói,tôi muốn kẻ nét đứt cho các viền dòng giữa và bao kép cho viền ngoài. Bạn bày tôi phát triển cái code ở trên với.

 

[TrungChinhs]

Gửi bạn TrungChinhs đúng như lời sealand nói,tôi muốn kẻ nét đứt cho các viền dòng giữa và bao kép cho viền ngoài. Bạn bày tôi phát triển cái code ở trên với.

Để kẻ một bảng thông thường (kẻ dọc, ngang), ta chỉ cần 3 loại đường kẻ:
- Đường kẻ đứng
- Đường kẻ ngang
- Đường bao quanh.

Đường kẻ có 12 kiểu: nét liền hoặc nét đứt; nét đậm hoặc nét mảnh; nét đơn hoặc nét đôi; hoặc là sự phối hợp giữa các kiểu nét này

Các bạn chọn 1 vùng ít nhất là 4 ô (2 cột, 2 dòng) và lần lượt thay các số từ 1 đến 12 vào số màu đỏ để Test tìm kiểu nét:

Sub Test_Bodress()
    With Selection
        .Borders.LineStyle = 0                'Xoa duong ke cu (neu co)
        .BorderAround [SIZE=4][COLOR=#ff0000][B]1 [/B][/COLOR][/SIZE]                     'Duong bao quanh, thay vao so 1 cac so tu 1 den 12 de thu
        .Borders(11).LineStyle = [SIZE=4][COLOR=#ff0000][B]1 [/B][/COLOR][/SIZE]          'Duong ke dung
        .Borders(12).LineStyle = [SIZE=4][COLOR=#ff0000][B]1[/B][/COLOR][/SIZE]           'Duong ke ngang
    End With
End Sub

Đối với bảng theo yêu cầu của bạn thì Code như sau:

Sub Bodress()
    With Selection
        .Borders.LineStyle = 0          ' Xoa duong ke cu
        .BorderAround 9                 ' Duong bao quanh net doi
        .Borders(11).LineStyle = 1      ' Duong dung net lien
        .Borders(12).LineStyle = 2      ' Duong ngang net dut
    End With
End Sub

 

[kieuhuy_bmt]

Kính gửi các anh chị trên diễn đàn!
Vừa qua có các anh, chị: Sa_DQ, HYen17, Concogia, Trungchinhs, bác SeaLand và nhiều người khác..giúp nên phần 1 công việc đã cơ bản xong, xin cảm ơn tất cả. Vẫn loanh quanh ở cái dữ liệu trên, tôi tiếp tục nhờ mọi người giúp sức:
Cụ thể là: Rất nhiều dữ liệu từ phần mềm trút ra nó nằm ở từng Sheet, bây giờ làm sao nó tự động chuyển qua Sheet DATA thông qua một cái nút bấm. Tuy trên diễn đàn có nhiều trang đã nói rõ, nhưng công việc ở đây hơi đặc thù, mong mọi người thông cảm giúp đỡ (nhờ các bác xem File).

 

[sealand]

Bạn tham khảo xem sao

 

[kieuhuy_bmt]

Cảm ơn Sealand! Có cái menu xổ ra xem sướng mắt thật .
Có lẽ mình nói chưa kỹ nên bên Sheet đích dữ liệu bị lệch qua trái một cột.
Bạn sửa giúp mình Chuyển toàn bộ dữ liệu sang phải 1 cột. Riêng dữ liệu tên tờ bản đồ ở bên Sheet nguồn kg có số liệu thì lấy luôn tên của Sheet đưa vào cột A trong Sheet DATA.
Khi nào rảnh bạn giúp mình việc này với: Tại Sheet DATA mình muốn làm cái menu ấy cho các bảng bữa trước " đặt tên cái nút bấm là báo cáo" mở cái báo cáo ra trong đó chỉ ra các mẫu chi tiết tương ứng với mỗi bảng.

 

[sealand]

Tranh thủ buổi trưa nên test không kỹ, thông cảm nha.
Bạn sửa ở đoạn Code này:

Private Sub CommandButton1_Click()
Dim Dg, Tb, i, Cl1 As Range, Rg As Range, Sh As Worksheet
If Me.ListBox1.ListCount = 0 Then Exit Sub
If Me.CheckBox1.Value Then
Set Cl1 = Sheet6.[[B][COLOR=#ff0000]A[/COLOR][/B]65536].End(3).Offset(1)
If Cl1.Row < 4 Then Set Cl1 = Sheet6.[[B][COLOR=#ff0000]A[/COLOR][/B]4]
Else
Sheet6.[[B][COLOR=#ff0000]A[/COLOR][/B]4:E65536].ClearContents
Set Cl1 = Sheet6.[[B][COLOR=#ff0000]A[/COLOR][/B]4]
End If
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True Then
Set Sh = ThisWorkbook.Sheets(Me.ListBox1.List(i, 0))
Set Rg = Sh.Range("B10:E" & Sh.[B10].End(4).Row - 1)
Rg.Copy Cl1
[B][COLOR=#ff0000]Sheet6.Cells(Cl1.Row, "A").Resize(Rg.Rows.Count).Cells.Value = Me.ListBox1.List(i, 0)[/COLOR][/B]
Set Cl1 = Cl1.Offset(Rg.Rows.Count)
Dg = Dg + Rg.Rows.Count
End If
Next
Tb = IIf(Me.CheckBox1, "Ban chep noi " & Dg & " dong du lieu.", _
"Ban tao moi data voi " & Dg & " dong du lieu.")
Unload Me
MsgBox Tb, , "GPE"
End Sub

Bạn đổi mấy chữ A màu đỏ thành chữ B và thêm dòng màu đỏ là được. Hay chép đoan code sau đè vào:

Private Sub CommandButton1_Click()
Dim Dg, Tb, i, Cl1 As Range, Rg As Range, Sh As Worksheet
If Me.ListBox1.ListCount = 0 Then Exit Sub
If Me.CheckBox1.Value Then
Set Cl1 = Sheet6.[B65536].End(3).Offset(1)
If Cl1.Row < 4 Then Set Cl1 = Sheet6.[B4]
Else
Sheet6.[A4:E65536].ClearContents
Set Cl1 = Sheet6.[B4]
End If
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True Then
Set Sh = ThisWorkbook.Sheets(Me.ListBox1.List(i, 0))
Set Rg = Sh.Range("B10:E" & Sh.[B10].End(4).Row - 1)
Rg.Copy Cl1
Sheet6.Cells(Cl1.Row, "A").Resize(Rg.Rows.Count).Cells.Value = Me.ListBox1.List(i, 0)
Set Cl1 = Cl1.Offset(Rg.Rows.Count)
Dg = Dg + Rg.Rows.Count
End If
Next
Tb = IIf(Me.CheckBox1, "Ban chep noi " & Dg & " dong du lieu.", _
"Ban tao moi data voi " & Dg & " dong du lieu.")
Unload Me
MsgBox Tb, , "GPE"
End Sub

 

[kieuhuy_bmt]

Đc rồi Sealand ơi!
Bạn kiểm tra sửa giúp, khi bỏ kiểm để nhập DATA mới cái cột A "tên mảnh " nó vẫn còn ở đó. Làm sao khi "bỏ xóa " là hắn xóa luôn theo những dữ liệu khác.

 

[sealand]

Nó ở đây:
..............................

1.If Me.CheckBox1.Value Then
2.Set Cl1 = Sheet6.[A65536].End(3).Offset(1)
3.If Cl1.Row < 4 Then Set Cl1 = Sheet6.[A4]
4.Else
5.Sheet6.[A4:E65536].ClearContents
6.Set Cl1 = Sheet6.[A4]
7.End If


Lưu ý, chữ A màu đỏ ở dòng 5 không đổi vẫn là chữ A

 

[kieuhuy_bmt]

Sealand ơi!
Không biết nhầm chỗ nào trong Code mà hắn chỉ tổng hợp những Sheet có chữ "B" nếu lic toàn bộ.
Còn lic 1 Sheet thì kg sao! Bạn kiểm tra giúp.

 

[huuthang_bd]

Sealand ơi!
Không biết nhầm chỗ nào trong Code mà hắn chỉ tổng hợp những Sheet có chữ "B" nếu lic toàn bộ.
Còn lic 1 Sheet thì kg sao! Bạn kiểm tra giúp.

Bạn sửa code của cái CommandButton1 lại như thế này:

Private Sub CommandButton1_Click()
Dim Dg, Tb, i, Cl1 As Range, Rg As Range, Sh As Worksheet
If Me.ListBox1.ListCount = 0 Then Exit Sub
If Me.CheckBox1.Value Then
    Set Cl1 = Sheet6.[B65536].End(3).Offset(1)
Else
    Sheet6.[A4:E65536].ClearContents
    Set Cl1 = Sheet6.[B4]
End If
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) = True Then
        Set Sh = ThisWorkbook.Sheets(Me.ListBox1.List(i, 0))
        Set Rg = Sh.Range("B10:E" & Sh.[B10].End(4).Row - 1)
        Rg.Copy Cl1
        Cl1.Offset(, -1).Resize(Rg.Rows.Count).Value = Me.ListBox1.List(i, 0)
        Dg = Dg + Rg.Rows.Count
        Set Cl1 = Sheet6.[B65536].End(3).Offset(1)
    End If
Next
Tb = IIf(Me.CheckBox1, "Ban chep noi " & Dg & " dong du lieu.", _
"Ban tao moi data voi " & Dg & " dong du lieu.")
Unload Me
MsgBox Tb, , "GPE"
End Sub

 

[kieuhuy_bmt]

Cảm ơn bạn Huuthang_BD! (lần đầu tiên gặp, xưng Bạn cho đỡ khách xáo, bạn thông cảm nhé).
Cái bạn giúp..nó chạy ngon rồi. Mình hỏi bạn thêm:
Ở các sheet nguồn do anh em để thứ tự các cột không đồng nhất, nơi thì thế này nơi thì thế kia, rồi phần khoảng trên tiêu đề nơi thì 6 hàng nơi thì 7 hoặc 8,9 vv.. vậy bài toán mình muốn nhờ là xử lý cái Code sao cho trong mọi trường hợp kể trên bên Sheet DATA vẫn tổng hợp đúng (Lấy "tên cột" bên Sheet DATA làm tiêu chí - chuẩn).
Mình nhờ tất cả mọi người giúp tay.

 

[sealand]

Đã nói đến Code (To tát 1 chút là lập trình) thì dữ liệu càng chuẩn mực càng đơn giản vấn đề.
Hơn nữa, bạn nói đây là tổng hợp dữ liệu của phần mềm khác kết xuất ra. Vậy thì không lẽ nào mỗi bảng 1 kiểu. Nếu để tuỳ ý thì cũng phải có 1 cái gì đó như tiê đề cột chẳng hạn để nhận diện thì mới biêt là lấy từ đâu chớ

 

[huuthang_bd]

Cảm ơn bạn Huuthang_BD! (lần đầu tiên gặp, xưng Bạn cho đỡ khách xáo, bạn thông cảm nhé).
Cái bạn giúp..nó chạy ngon rồi. Mình hỏi bạn thêm:
Ở các sheet nguồn do anh em để thứ tự các cột không đồng nhất, nơi thì thế này nơi thì thế kia, rồi phần khoảng trên tiêu đề nơi thì 6 hàng nơi thì 7 hoặc 8,9 vv.. vậy bài toán mình muốn nhờ là xử lý cái Code sao cho trong mọi trường hợp kể trên bên Sheet DATA vẫn tổng hợp đúng (Lấy "tên cột" bên Sheet DATA làm tiêu chí - chuẩn).
Mình nhờ tất cả mọi người giúp tay.

Bạn hãy đưa tất cả các kiểu dữ liệu có thể có vào chung một file và gửi lên xem. Được hay không cũng còn tùy vào mớ hỗn độn đó có một quy tắc chung nào không.

 

[kieuhuy_bmt]

Mình gửi luôn đây! bạn xem giúp, có gì mình bổ sung thêm.

 

[kieuhuy_bmt]

Đã nói đến Code (To tát 1 chút là lập trình) thì dữ liệu càng chuẩn mực càng đơn giản vấn đề.
Hơn nữa, bạn nói đây là tổng hợp dữ liệu của phần mềm khác kết xuất ra. Vậy thì không lẽ nào mỗi bảng 1 kiểu. Nếu để tuỳ ý thì cũng phải có 1 cái gì đó như tiê đề cột chẳng hạn để nhận diện thì mới biêt là lấy từ đâu chớ

Cảm ơn sealand!
Đúng là khi kết xuất từ phần mềm các cột tiêu đề đều giống nhau. Tuy nhiên là tiếng việt đều kg có dấu, vì vậy trong quá trình anh em sửa thêm bớt mỗi người làm một kiều, nhưng chủ yếu họ dữ cái dữ liệu là chính. bạn xem sử giúp nhé.

 

[huuthang_bd]

Cảm ơn sealand!
Đúng là khi kết xuất từ phần mềm các cột tiêu đề đều giống nhau. Tuy nhiên là tiếng việt đều kg có dấu, vì vậy trong quá trình anh em sửa thêm bớt mỗi người làm một kiều, nhưng chủ yếu họ dữ cái dữ liệu là chính. bạn xem sử giúp nhé.

Nếu dữ liệu được xuất từ phần mềm thì có lẽ không nên làm thêm nữa vì cũng như anh sealand đã nói dữ liệu càng chuẩn thì giải quyết càng đơn giản. Thay vì cố đi theo người ta mà chưa biết người ta dẫn mình đi đâu thì hãy dẫn họ theo mình.
Ở trường hợp của bạn, Giá trị các ô tiêu đề không ảnh hưởng đến kết quả khi sử dụng code cũ. Vậy, bạn hãy yêu cầu mọi người không được thêm bớt dòng cột mà chỉ chỉnh sửa các tiêu đề mà thôi, yêu cầu này có lẽ không đến nỗi quá khó.

 

[kieuhuy_bmt]

Nếu dữ liệu được xuất từ phần mềm thì có lẽ không nên làm thêm nữa vì cũng như anh sealand đã nói dữ liệu càng chuẩn thì giải quyết càng đơn giản. Thay vì cố đi theo người ta mà chưa biết người ta dẫn mình đi đâu thì hãy dẫn họ theo mình.

Buồn ơi!
Đúng là mình đòi hỏi thái quá! Gửi các bác cái File, một dạng nguyên gốc từ phần mềm Microtion ..xuất ra.

Ở trường hợp của bạn, Giá trị các ô tiêu đề không ảnh hưởng đến kết quả khi sử dụng code cũ. Vậy, bạn hãy yêu cầu mọi người không được thêm bớt dòng cột mà chỉ chỉnh sửa các tiêu đề mà thôi, yêu cầu này có lẽ không đến nỗi quá khó.

Chỉ thêm vài ký tự là ổn nhưng với mình mò mẫm lâu lắm, chắc gì đã xong. Hỏi các chuyên gia biết thể nào cũng bị la, nhưng bây giờ làm sao đây.

 

[sealand]

Nếu không nhầm thì tình hình sẽ như thế này:
-Phần mềm sẽ kết xuất ra n file có cấu trúc hệt như dc9
-Tốt nhất bạn đừng làm gì cả mà chỉ chép tất chúng vào thu mục nào đó.
-Viết code tổng hợp chung n file vào 1 sheet.
-Bạn giải thích cho anh em rõ ý nghĩa từng cột trong dc9 và mục dích tổng hợp như thế nào.

Như vậy, đỡ bàn đi tính lại nhiều.

 

[sealand]

Nếu đã đồng ý thì giờ bạn đưa lên khoảng 2-3 file kết xuất đảm bảo nguyên gốc và yêu cầu tổng hợp ra sao, anh em sẽ giúp bạn

 

[kieuhuy_bmt]

Nếu đã đồng ý thì giờ bạn đưa lên khoảng 2-3 file kết xuất đảm bảo nguyên gốc và yêu cầu tổng hợp ra sao, anh em sẽ giúp bạn

Thế thì tốt quá nhờ tất cả mọi người.

Trong File gửi có thêm các mẫu File Word (có 3 mẫu theo hướng dẫn của Bộ TN&MT)
nhờ các bác xem hướng dẫn trong File luôn.
Trong thư mục "Tonghop_A" có 3 File Excel nguyên mẫu nhờ các bác xử lý ra luôn các mẫu theo File Word ở trên, tuy nhiên mình có ý kiến riêng tạo thêm File thứ 4 (mọi tổng hợp báo cáo nhập xuất ra sẽ đc ghi vào File này). Xong công đoạn đo đạc bản đồ.
Đến công đoạn kê khai cấp giấy CNQSD đất sẽ sử dụng DATA và các báo cáo khác (vừa rồi các bác đã giúp) để làm sẽ trình bày sau.

 

[TrungChinhs]

Thế thì tốt quá nhờ tất cả mọi người.

Trong File gửi có thêm các mẫu File Word (có 3 mẫu theo hướng dẫn của Bộ TN&MT)
nhờ các bác xem hướng dẫn trong File luôn.
Trong thư mục "Tonghop_A" có 3 File Excel nguyên mẫu nhờ các bác xử lý ra luôn các mẫu theo File Word ở trên, tuy nhiên mình có ý kiến riêng tạo thêm File thứ 4 (mọi tổng hợp báo cáo nhập xuất ra sẽ đc ghi vào File này). Xong công đoạn đo đạc bản đồ.
Đến công đoạn kê khai cấp giấy CNQSD đất sẽ sử dụng DATA và các báo cáo khác (vừa rồi các bác đã giúp) để làm sẽ trình bày sau.

Chương trình này tuy không khó lắm nhưng tốn khá nhiều thời gian và công sức, cách làm sẽ diễn ra như sau:
Trong 1 tờ bản đồ có nhiều chủ hộ, mỗi hộ có nhiều thửa đất và tùy theo địa chỉ của các chủ hộ mà trong 1 tờ bản đồ có thể có nhiều địa chỉ (đơn vị hành chính) khác nhau. Vấn đề cần phải giải quyết là phải đưa được các thửa đất của cùng một chủ hộ ở các tờ bản đồ khác nhau về cùng 1 chỗ; tách các hộ ở cùng 1 đơn vị hành chính thành các biểu (Sheet) riêng.... đó là chưa kể đến việc phải kiểm tra các tình huống thường xảy ra như trùng tên chủ hộ, trùng thửa đất, kiểm tra ký hiệu loại đất, tổng hợp số loại của các hộ thành số loại đất của cả đơn vị (thôn)...

Vì vậy mọi người chỉ có thể giúp bạn từng công đoạn mà thôi.

 

[sealand]

Bạn này thật là, bạn nhờ tổng hợp dữ liệu anh en giúp Tổng hợp DL thôi. Còn báo cáo thì từ bài đầu đến giờ bạn phải vận dung chứ

Lưu ý:
-Tải về máy trước khi Test.
-Trong thư mục chỉ có file tổng hợp và file kết xuất.
-Thư mục có thể để ở dâu cũng được.
-Minh co việc 1 chút nên không kịp, nếu tổng hợp từ mảng nguồn sang mảng đích trước khi chép xuống thì tốc độ nhanh hơn 1 chút.

 

[kieuhuy_bmt]

Chương trình này tuy không khó lắm nhưng tốn khá nhiều thời gian và công sức, cách làm sẽ diễn ra như sau:
Trong 1 tờ bản đồ có nhiều chủ hộ, mỗi hộ có nhiều thửa đất và tùy theo địa chỉ của các chủ hộ mà trong 1 tờ bản đồ có thể có nhiều địa chỉ (đơn vị hành chính) khác nhau. Vấn đề cần phải giải quyết là phải đưa được các thửa đất của cùng một chủ hộ ở các tờ bản đồ khác nhau về cùng 1 chỗ; tách các hộ ở cùng 1 đơn vị hành chính thành các biểu (Sheet) riêng.... đó là chưa kể đến việc phải kiểm tra các tình huống thường xảy ra như trùng tên chủ hộ, trùng thửa đất, kiểm tra ký hiệu loại đất, tổng hợp số loại của các hộ thành số loại đất của cả đơn vị (thôn)...

Vì vậy mọi người chỉ có thể giúp bạn từng công đoạn mà thôi.

Cảm ơn bạn!
Vấn đề bạn đề cập thực ra ở trang này, tuy lắt nhắt, nhìn có vẻ nhiều việc nhưng nhờ mọi người giúp đã làm xong rồi. Gút lại như sau:
Phần mềm Micro... xuất ra 1 dạng File Excel ----> Chỉnh sửa các file .. loại bỏ cột thừa,,chỉnh Fon, thêm tiêu đề .. ----> chuyển hết các file vào 1 file tổng (mỗi sheet trước kia là mỗi File và là 1 mảnh bản đồ) ----> chuyển dữ liệu từ các sheet sang Sheet DATA ---->từ DATA tạo các bảng tổng hợp.
- Khu vực màu đỏ đã xong
- khu vực màu xanh thực ra là anh em cơ quan đã làm thủ công, bây giờ mình muốn nhờ các bạn xử lý chỗ này đấy.
Bạn chú ý: việc trùng tên, trùng mảnh vv..kg ảnh hưởng gì cả (mỗi thửa đất là 1 dòng, phải đc in ra để ký tên). làm sao tự động copy dán vào File tổng là OK.
Mình đưa cái công đoạn đã xong lên bạn xem nhé (xem File). (Mình đang gửi bài này thì Sealad đã có ý tưởng ở bài trên, cùng up 1 lúc)
* Trong chương trình này của mình. Chắc chắn cần phải xử lý những cái nút bấm về trang, sang trang, xuống trang vv..Bạn xem giúp mình cái bài này với: http://www.giaiphapexcel.com/forum/...-bấm-thêm-đến-nhiều-sheet&p=365526#post365526

 

[kieuhuy_bmt]

Bạn này thật là, bạn nhờ tổng hợp dữ liệu anh en giúp Tổng hợp DL thôi. Còn báo cáo thì từ bài đầu đến giờ bạn phải vận dung chứ

Lưu ý:
-Tải về máy trước khi Test.
-Trong thư mục chỉ có file tổng hợp và file kết xuất.
-Thư mục có thể để ở dâu cũng được.
-Minh co việc 1 chút nên không kịp, nếu tổng hợp từ mảng nguồn sang mảng đích trước khi chép xuống thì tốc độ nhanh hơn 1 chút.

Đúng là lan man quá. Do mình muốn giải thích thêm cho người khác nên kg đi vào trọng tâm.
1. Bạn ơi! ở ngoài có bao nhiêu cái File, thì chuyển vào trong File tổng hợp bấy nhiêu cái Sheet "tên File chuyển thành tên Sheet nha bạn - tên sheet là tên mảnh bản đồ-anh em in ấn tại đây". Rồi từ đấy mới tổng hợp qua DATA (công đoạn này bạn giúp xong rồi, kg bàn nữa).
2. Mình chạy thử cái Tonghop_A, nhưng hình như lỗi chỗ nào ấy.

 

[sealand]

Bạn nói cụ thể hơn về cái lỗi xem nào?

 

[sealand]

Bài này, mình chuyển dùng mảng tốc độ hơn nhiều. Kể cả làm bảng chi tiết cũng chỉ bằng file trước

 

[kieuhuy_bmt]

Bài này, mình chuyển dùng mảng tốc độ hơn nhiều. Kể cả làm bảng chi tiết cũng chỉ bằng file trước

cảm ơn, Tuyệt quá!
Sau khi xóa hết các sheet .. mình bấm nút, hắn báo như sau (xem file). hay là do OF của mình thiếu cái gì đó, máy cơ quan chiều nay cũng báo vậy. Ban kiểm tra giúp.

 

[sealand]

Mình chạy file bạn gửi lại chạy bình thường. Vậy khi nó báo lỗi bạn nhấn nút Debug nó sẽ dẫn đến dòng lệnh gây lỗi và mình sẽ xác định được.
Trong file không sử dụng bất kỳ object đặc biệt nào cả.

 

[kieuhuy_bmt]

Sao kg cho gửi trang này! phải nhờ mediafie

Lỗi đây bạn ơi! nó bôi vàng ở dòng lệnh này: Set fs = Application.FileSearch
- Xử lý cho mình luôn mấy chỗ ở các sheet (xem file xulythem_1).

http://www.mediafire.com/download.php?pjaraupbhtid37d

 

[sealand]

Trước hết mình sử lý lỗi, trước mình dùng FileSearch có thể Office của bạn có vấn đề. Rất có thể nó giống ở đây http://www.giaiphapexcel.com/forum/showthread.php?31231-Sự-cố-với-Application.FileSearch
Vậy nay mình dùng Scripting.FileSystemObject chăc là ổn định.

­Lưu ý: Tải lại file có cả phần bổ xung

 

[kieuhuy_bmt]

Trước hết mình sử lý lỗi, trước mình dùng FileSearch có thể Office của bạn có vấn đề. Rất có thể nó giống ở đây http://www.giaiphapexcel.com/forum/showthread.php?31231-Sự-cố-với-Application.FileSearch
Vậy nay mình dùng Scripting.FileSystemObject chăc là ổn định.

­Lưu ý: Tải lại file có cả phần bổ xung

Vẫn kg đc (tải File kg đc)
Nó ra cái hộp có chữ GPE

 

[sealand]

Vậy thì bạn tải theo link sau:

http://www.mediafire.com/?78b31ocoin52hog

 

[kieuhuy_bmt]

Vậy thì bạn tải theo link sau:

http://www.mediafire.com/?78b31ocoin52hog

Không phải thế, mình Dw xuống rồi nhưng chạy file vẫn kg đc .
mình quên mất ý là tải cái File báo lỗi lên nhưng kg hiểu sao kg gửi lên được.
đành phải gửi qua meriafire
http://www.mediafire.com/?18snlhmx87exuoo

 

[sealand]

Cái này không phải là lỗi mà nó thông báo cho bạn rằng chả có file và dòng dữ liệu nào hợp lệ cả. Bạn sửa code để có thông báo như ý:
Lý do:
1/Không có file dữ liệu nào trong thư mục cả.
2/Chưa down về máy nên không xác định được thư mục.
3/File kết xuất của bạn không đúng cấu trúc.

 

[kieuhuy_bmt]

Vậy là OF 2007 của mình có vấn đề!
Copy sang máy OF 2003 thì chạy đc. Tuy nhiên mình thêm 1 vài File xem sao thì nó chưa tổng hợp đc những cái File thêm, xóa cái cũ đi bấm nút thì máy vẫn tổng hợp cái ban đầu. Bạn xem lại giúp (chạy cho các phiên bản OF).

 

[sealand]

Như đã nói, Code là phải tôn trọng cấu trúc dữ liệu thì mới đơn giản được, nếu không phải dò tìm và xác định vùng dữ liệu hợp lệ cực lắm. Mình khẳng định bạn sai cấu trúc. Mình đã nói là từ phần mềm xuất ra cứ để nguyên mới OK được.
Riêng Exc 2007 thì thực sự mình không thích dùng. Chính vì vậy mà mình không cài vào máy bao giờ. Vậy việc test và chuyển đổi bạn cố gắng vậy.

 

[kieuhuy_bmt]

Như đã nói, Code là phải tôn trọng cấu trúc dữ liệu thì mới đơn giản được, nếu không phải dò tìm và xác định vùng dữ liệu hợp lệ cực lắm. Mình khẳng định bạn sai cấu trúc. Mình đã nói là từ phần mềm xuất ra cứ để nguyên mới OK được.
Riêng Exc 2007 thì thực sự mình không thích dùng. Chính vì vậy mà mình không cài vào máy bao giờ. Vậy việc test và chuyển đổi bạn cố gắng vậy.

Đã lâu rồi mình bị những name do vi rút tạo ra (excel 2003 kg xử lý nhanh đc), máy nặng quá vì vậy mới dùng đến excel 2007 chỉ để xóa nhanh name rác mà thôi, bản thân cũng kg thích nó.
mình cài lại ex 2003 rồi, chạy file nó báo cái bảng sau:
Ở chế độ:VeryHigh (lỗi xem hình 1).
kg biết do đâu.
"test và chuyển đổi" thực sự khó quá. test cái code hả bạn?

 

[sealand]

Bạn phải đặt là Low chứ. Đặt hight thì code sao chạy được.
Test và chuyển đổi là sang 2007 ấy, chứ mình không có thì Test làm sao được.

 

[kieuhuy_bmt]

Đúng là lúa quá trời ơi! mình cứ nghĩ Low là thấp nhất ..hạn chế nó, bây giờ OK rùi.
Sửa code thế nào để thêm n file thì có n sheet trong "tonghop bao cao" bạn ơi !

 

[haonlh]

Tôi có theo dõi đề tài này từ đầu, nhưng bận quá. Cuối năm mà.

Có lẽ dùng Pivot là tạm được. Vì Pivot không cho sắp các tên cột theo 3 loại đất nên sau khi tạo pi vot, ta chép Value, rồi tạo macro đổi chỗ 2 cột. Hoặc Sort theo hàng ngang. Tất nhiên phải viết thứ tự các tên cột cho chúng

Pi vot cho chép tên hàng nên dễ. Nhưng trong file đính kèm, tôi đã đặt lại cột đầu là DC001, DC002, ... đến hết nên không phải xử lý

Sheet T1 tương ứng với Tổng1,...

Nhân đây hỏi kieuhuy: chỉ cho cách MicroStation xuất file dữ liệu thô (trong 1 bài bạn có gửi file đó, fon chữ TCVN3)

Cảm ơn

 

[sealand]

Đúng là lúa quá trời ơi! mình cứ nghĩ Low là thấp nhất ..hạn chế nó, bây giờ OK rùi.
Sửa code thế nào để thêm n file thì có n sheet trong "tonghop bao cao" bạn ơi !

Thì bạn cứ đổ n file vào cái nồi lẩu đó xem sao.

 

[kieuhuy_bmt]

Thì bạn cứ đổ n file vào cái nồi lẩu đó xem sao.

Thử nhiều lần nhưng kg hiểu sao! chưa đc, khi bấm vào nó ra cái bảng thì thấy có hết các đường dẫn, bấm Ok thì nó chỉ tông hợp cái cũ.

 

[sealand]

Thử load 1 số file mới lên Mediafile xem nào

 

[kieuhuy_bmt]

Thử load 1 số file mới lên Mediafile xem nào

Mình copy chính cái file trong thu muc do ra thanh nhieu file.
http://www.mediafire.com/?31mhdp2e8y88w1c

 

[sealand]

Trước hết, tôi không biết bạn có ý gì không nhưng các file bạn đưa lên không phải là do phền mềm kết xuất ra. Ngoài dữ liệu ra trong VBA bạn thêm vào 1 Module để tự động thêm file StartUp.xls vào Folder StartUp. Với việc này, thì trình độ VB của bạn không phải như bạn đang hỏi. Hay là bạn cố tình thử sự nhiệt tình của anh em?
Thôi thì tôi cứ coi như bạn vô tình không cố ý đi. Bạn làm như sau:

-Bạn thiết lập lại Security mức Very Hight.
-Bạn vào Menu Start---Documents: Trong danh sách file đã mở có StartUp.xls. Bấm chuột phải vào nó ---Chọn Property---Nhấn Find Target---Bạn xoá file đó đi.
-Nhấn giữ Shift mở file dc1.Vào VBA remove Module StartUp.Bạn sửa tên sheet bằng tên file bỏ .xls (Mạc định phần mềm kết xuất). Rồi lưu lại thoát ra.
-Lập lại lần lượt cho tất cả các file
-Giờ bạn lại thiết lập Sercurity ở mức Low và chạy bình thường.

(Lưu ý bạn, tôi coi đây là 1 dang virus macro nha)

 

[kieuhuy_bmt]

Trước hết, tôi không biết bạn có ý gì không nhưng các file bạn đưa lên không phải là do phền mềm kết xuất ra. Ngoài dữ liệu ra trong VBA bạn thêm vào 1 Module để tự động thêm file StartUp.xls vào Folder StartUp. Với việc này, thì trình độ VB của bạn không phải như bạn đang hỏi. Hay là bạn cố tình thử sự nhiệt tình của anh em?

- Mình kg có ý gì hết, băn khoăn duy nhất một điều là kg khéo thì có khi các bạn hiểu lầm, tuy nhiên trong cách hành văn của mình ở trên đã cho thấy điều đó. Thành thật mình mong mọi người bỏ qua.
- Mình đăng ký thành viên từ 2007, với VBA chỉ biết là mở xem lệnh bằng Alt + f11 và chạy lệnh = Alt + f8 thôi, chưa thực hành nhiều như lần này. Nói như bạn thì mình đang đc cộng thêm nhiều điểm rồi. Với đề tài trên, do làm mọi người cụt hứng nên đôi lúc thấy tình hình đi vào ngõ cụt. Bạn có biết kg mình đã tìm hiểu cách ủng hộ bằng kinh phí cho GPE, nhưng chưa biết cách làm thế nào. Các bạn đã giúp thì mình cảm ơn, và coi đây là một món nợ chưa đc trả.
(lại lan man quá rồi). Thử cách bạn bày cho xem có sáng dạ thêm tý nào kg.
Kg hiểu cách làm:
Nhờ bạn quay cho mình một đoạn phim với, mình ghi hình như sau:
.http://www.mediafire.com/?b888anh1ftej91p

 

[sealand]

Bạn nói vậy, thì cho mình xin lỗi. Nhưng mình thắc mắc là chỉ down từ file của mình không có mà về máy của bạn thì lại có. Bạn phải làm như mình nói ở bài trước để dọn dẹp hết cái StartUp ấy đi mới làm việc bình thường được. Nếu không nó sẽ chèn vào tất cả các file .XLS nào bạn mở ra. Mình giải thích cái lỗi xảy ra như thế này:
-Trong Code có đoạn: Mở file nguồn và gán cho nó vào biến Wb, điều này OK. Tiếp đoạn sau gán biến Sh là Sheets(1) của File đó. Những file của bạn không phải chỉ có 1 sheet và sheets(1) không phải là Worksheet nên việc gán biến phát sinh lỗi. Chỉ những file của mình gửi kèm là có 1sheet nên làm việc bình thường và chép được dữ liệu.
Sau khi dọn xong thì mọi hoạt động bình thường thôi, có nghĩa là bạn chép bao nhiêu file sẽ tổng hợp bấy nhiêu.

Mong bạn hiểu, không phải vì cách hành văn mà mình hơi bực về cái Module kèm trong các file mới của bạn tạo rác lung tung cả.
Bạn cũng lưu ý các Code có tên Startup, AutoExec.... có trong file phải kiểm tra xem để làm gì?

 

[thuynhungk1a]

Tốc độ bình thường mà ^^

 

[thuynhungk1a]

Cái này cũng được mà ^^

 

[kieuhuy_bmt]

Bạn nói vậy, thì cho mình xin lỗi.

Lỗi do mình tạo ra. bạn nói vậy ngại quá.

Nhưng mình thắc mắc là chỉ down từ file của mình không có mà về máy của bạn thì lại có.
..........
......Mong bạn hiểu, không phải vì cách hành văn mà mình hơi bực về cái Module kèm trong các file mới của bạn tạo rác lung tung cả.

Hay là do mình dùng các Add-in này (xem ảnh ở đây http://www.mediafire.com/?q17qgqyv71dchpj.

Bạn phải làm như mình nói ở bài trước để dọn dẹp hết cái StartUp ấy đi mới làm việc bình thường được. Nếu không nó sẽ chèn vào tất cả các file .XLS nào bạn mở ra.

Bạn quay 1 đoạn phim giải thích cho mình đc kg?

 

[sealand]

Hiện giờ mình đã sử lý hết rồi, nhưng bạn đã chạy code được chưa. Nếu chưa được thì cầm chắc là vẫn còn.

Khi bạn mở của sổ VBA trên Explore có 1 adin StartUp.Bạn nháy mở nó ra Module --Nháy tiếp mở Code --Xóa hết nó đi.
Trên phần code file của bạn cũng có Module StartUp y hệt. Bạn cũng xóa nó đi. Bạn thoát ra nó hỏi gì cũng lưu lại.

Bạn nhấn start---Documents---StartUp.xls bạn đưa chuột để vệt sáng vào dòng đó rồi nháy chuột phải mở Properties---Bấm nút Find Target nó sẽ đưa bạn đến thư mục như hình kèm, bạn xóa thủ phạm đi.

 

[kieuhuy_bmt]

Tôi có theo dõi đề tài này từ đầu, nhưng bận quá. Cuối năm mà.

Có lẽ dùng Pivot là tạm được. Vì Pivot không cho sắp các tên cột theo 3 loại đất nên sau khi tạo pi vot, ta chép Value, rồi tạo macro đổi chỗ 2 cột. Hoặc Sort theo hàng ngang. Tất nhiên phải viết thứ tự các tên cột cho chúng

Pi vot cho chép tên hàng nên dễ. Nhưng trong file đính kèm, tôi đã đặt lại cột đầu là DC001, DC002, ... đến hết nên không phải xử lý

Sheet T1 tương ứng với Tổng1,...

Nhân đây hỏi kieuhuy: chỉ cho cách MicroStation xuất file dữ liệu thô (trong 1 bài bạn có gửi file đó, fon chữ TCVN3)

Cảm ơn

Xin lỗi bạn, hôm nay mới thấy bài của bạn.
Phần mềm MicroStation chuyên dùng cho ngành bản đồ, mình cũng kg cài làm gì, thấy anh em xuất file ra là có dạng đó rồi (bạn xem File ở đây http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=75372&d=1323836261). Cách làm thì dễ nếu bạn hỏi đúng anh em trong ngành, mình dân hành chính nên kg giúp gì đc.
Dùng Pivot cũng đc nhưng khổ nỗi lại phải biên tập dài dài.. để in. Tóm lại theo cách của Sealad mình thấy hay, kg biết bạn có ý tưởng mới kg. Cuối cùng nếu đóng gói chuyển sang đc Add-in thì tuyệt.

 

[kieuhuy_bmt]

Bạn nói vậy, thì cho mình xin lỗi. Nhưng mình thắc mắc là chỉ down từ file của mình không có mà về máy của bạn thì lại có. Bạn phải làm như mình nói ở bài trước để dọn dẹp hết cái StartUp ấy đi mới làm việc bình thường được. Nếu không nó sẽ chèn vào tất cả các file .XLS nào bạn mở ra. Mình giải thích cái lỗi xảy ra như thế này:
-Trong Code có đoạn: Mở file nguồn và gán cho nó vào biến Wb, điều này OK. Tiếp đoạn sau gán biến Sh là Sheets(1) của File đó. Những file của bạn không phải chỉ có 1 sheet và sheets(1) không phải là Worksheet nên việc gán biến phát sinh lỗi. Chỉ những file của mình gửi kèm là có 1sheet nên làm việc bình thường và chép được dữ liệu.
Sau khi dọn xong thì mọi hoạt động bình thường thôi, có nghĩa là bạn chép bao nhiêu file sẽ tổng hợp bấy nhiêu.

Mong bạn hiểu, không phải vì cách hành văn mà mình hơi bực về cái Module kèm trong các file mới của bạn tạo rác lung tung cả.
Bạn cũng lưu ý các Code có tên Startup, AutoExec.... có trong file phải kiểm tra xem để làm gì?

Không có cái Startup nào, nản ghê.

 

[kieuhuy_bmt]

Khi bạn mở của sổ VBA trên Explore có 1 adin StartUp.Bạn nháy mở nó ra Module --Nháy tiếp mở Code --Xóa hết nó đi.
Trên phần code file của bạn cũng có Module StartUp y hệt. Bạn cũng xóa nó đi. Bạn thoát ra nó hỏi gì cũng lưu lại.

Bạn làm mẫu cho mình xem, thực ra kg hiểu lắm.

Bạn kiểm tra giúp cái code cuối cùng xem có đúng kg!

Option Explicit
Sub ThopDT()
Dim FSO, SourceFolder, SubFolder, Tb As String
Dim FileItem, r As Long, Cl1 As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(ThisWorkbook.Path & "\")
Sheet6.[A4:I65536].ClearContents
Set Cl1 = Sheet6.[A4]
For Each FileItem In SourceFolder.Files
If FileItem.Type = "Microsoft Excel Worksheet" Then
If FileItem.Name <> ThisWorkbook.Name Then
Copydata FileItem.Path, Cl1, Tb
End If
End If
Next
MsgBox Tb, , "GPE"
Thoat:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub Copydata(ByVal Ten As String, ByRef Vt As Range, ByRef Tb As String)
Dim Wb As Workbook, Sh As Worksheet, Sh1 As Worksheet
Dim Cl As Range, Tm, j, Tm1()
Set Wb = Workbooks.Open(Ten)
Set Sh = Wb.Sheets(1)
Set Cl = Sh.[B65536].End(3).Offset(-1)
If Cl.Row < 4 Then Exit Sub
Tm = Sh.Range(Sh.[B4], Cl).Resize(, 14)
ReDim Tm1(1 To UBound(Tm, 1), 1 To 5)
For j = 1 To UBound(Tm, 1)
Tm1(j, 1) = Sh.Name
Tm1(j, 2) = Tm(j, 1)
Tm1(j, 3) = Tm(j, 7)
Tm1(j, 4) = Tm(j, 13)
Tm1(j, 5) = Tm(j, 14)
Next
Vt.Resize(UBound(Tm, 1), 5) = Tm1
Set Vt = Vt.Offset(UBound(Tm, 1))
'Tao Sheet rieng
On Error Resume Next
ThisWorkbook.Sheets(Sh.Name).Delete
On Error GoTo Thoat
Set Sh1 = ThisWorkbook.Sheets.Add
Sh1.Name = Sh.Name
Sh1.[A9].Resize(UBound(Tm, 1), 5) = Tm1
Sh1.[A9].Resize(UBound(Tm, 1)).ClearContents
Sheet1.[A1:G8].Copy Sh1.[A1]
For j = 1 To 7
Sh1.Columns(j).ColumnWidth = Sheet1.Columns(j).ColumnWidth
Next
Sh1.[A5] = Sh1.[A5] & " " & Sh.Name
Sheet1.[A11:G11].Copy
Sh1.[A9].Resize(UBound(Tm, 1), 7).PasteSpecial Paste:=xlPasteFormats
Sheet1.[A15:G37].Copy Sh1.[A9].Offset(UBound(Tm, 1))
If Len(Tb) = 0 Then Tb = "KET QUA TONG HOP DU LIEU"
Tb = Tb & Chr(10) & Ten & "   << So dong: " & UBound(Tm, 1) & ">>"
Wb.Close
Thoat:
Set Wb = Nothing
Set Sh = Nothing
End Sub

 

[sealand]

Code bạn đưa lên chuẩn mà, chạy tốt trên máy của mình.
Bạn thông cảm, hôm qua mình bưc là bị dính chuyện như thế này này

http://www.giaiphapexcel.com/forum/...ct(StarrtUp.xls)&p=367013&posted=1#post367013

 

[kieuhuy_bmt]

Code bạn đưa lên chuẩn mà, chạy tốt trên máy của mình.
Bạn thông cảm, hôm qua mình bưc là bị dính chuyện như thế này này

Bạn cũng thông cảm.
Mình tìm ra cái lỗi cơ bản như sau:
Mình nhờ bạn lấy cái tên file "nguồn"chuyển vào trong, lấy tên đó là tên Sheet "đích". nhưng thực ra bạn lấy tên Sheet trong File "nguồn".....
vì vậy khi mình copy 1 file để thêm file (trong file ấy chưa đổi tên Sheet) nên nó kg hiểu (có tên sheet trùng ở "nguồn".
Bây giờ nhờ bạn xem tiếp giúp mình xử lý một lỗi nhỏ. (xem file)

 

[kieuhuy_bmt]

sealand đi vắng..hay là bận cuối năm!

 

[Tranhoe]

Trước hết, tôi không biết bạn có ý gì không nhưng các file bạn đưa lên không phải là do phền mềm kết xuất ra. Ngoài dữ liệu ra trong VBA bạn thêm vào 1 Module để tự động thêm file StartUp.xls vào Folder StartUp. Với việc này, thì trình độ VB của bạn không phải như bạn đang hỏi. Hay là bạn cố tình thử sự nhiệt tình của anh em? .......................
(Lưu ý bạn, tôi coi đây là 1 dang virus macro nha)

Đừng trách Bạn kieuhuy_bmt mà tội nghiệp. Đ

 

[sealand]

Lu bu quá, hôm nay mới biết. Mình sẽ xem lại sau.

 

[sealand]

Lỗi của bạn là file DC7 đã chỉnh sửa sai cấu trúc so với file nguồn. Như đã thống nhất ban đầu là các file nguồn vẫn giữ nguyên từ file kết xuất để việc tổng hợp chính xác.

 

[Tranhoe]

@ kieuhuy_bmt
File DC7.xls có dữ liệu không đúng cấu trúc như các file khác (từ phần mềm xuất ra), Bạn phải thay file khác (hoặc xóa nó đi) thì chương trình chạy tốt thôi.
Mình có sửa 1 tí : sửa Font trong sheet Tonghopbaocao, sửa công thức trong sheet Tmp để khi tổng hợp thì công thức tính tổng số thửa của từng sheet DC thể hiện đúng và thêm phần PageSetup lặp lại tiêu đề Dòng (cho các Trang kết quả) trong Code.
File đính kèm: http://www.4shared.com/rar/3vraJBoP/Tonghop_D.html