Giải pháp nào để tăng tốc độ cho bảng tính.

[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.