Cải thiện tốc độ đánh số tự động và định dạng bảng tính (1 người xem)

Cá ngừ F1 · 12/7/14

Sau khi tham khảo code đánh số thứ tự tự động và định dạng bảng tính từ bài viết của thầy PTM, nguồn: http://www.giaiphapexcel.com/forum/...g-VBA-vào-Pivot-table-để-lập-báo-cáo-theo-mẫu
E có áp dụng vào file của mình, đánh số thứ tự tự đồng và kẻ bảng từ cột A đến cột Z, tuy nhiên áp dụng vào thấy hơi chậm (mất gần 4s).
Có cách nào cải thiện ko ạh?
E cảm ơn !!!

Quang_Hải · 12/7/14

Cá ngừ F1 đã viết:
Sau khi tham khảo code đánh số thứ tự tự động và định dạng bảng tính từ bài viết của thầy PTM, nguồn: http://www.giaiphapexcel.com/forum/...g-VBA-vào-Pivot-table-để-lập-báo-cáo-theo-mẫu
E có áp dụng vào file của mình, đánh số thứ tự tự đồng và kẻ bảng từ cột A đến cột Z, tuy nhiên áp dụng vào thấy hơi chậm (mất gần 4s).
Có cách nào cải thiện ko ạh?
E cảm ơn !!!

Trong bụng muốn bao nhiêu là vừa vậy?

Cá ngừ F1 · 12/7/14

quanghai1969 đã viết:
Trong bụng muốn bao nhiêu là vừa vậy?

Click... rẹt phát.. dưới 0.5s là PHÊ ạh...

ndu96081631 · 12/7/14

Cá ngừ F1 đã viết:
Sau khi tham khảo code đánh số thứ tự tự động và định dạng bảng tính từ bài viết của thầy PTM, nguồn: http://www.giaiphapexcel.com/forum/...g-VBA-vào-Pivot-table-để-lập-báo-cáo-theo-mẫu
E có áp dụng vào file của mình, đánh số thứ tự tự đồng và kẻ bảng từ cột A đến cột Z, tuy nhiên áp dụng vào thấy hơi chậm (mất gần 4s).
Có cách nào cải thiện ko ạh?
E cảm ơn !!!

Chậm là do vụ Format mà ra.
Code của bạn là:

Mã:

Sub SoTT(Rng As Range)
  With Rng
    .Resize(10000, 1).Clear
    .Value = Evaluate("=row(R:R)")
    .NumberFormat = "00"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
  End With
End Sub 
Sub DrawBorder(Rng As Range)
  On Error Resume Next
  With Rng
    For i = 8 To IIf(Rng.Rows.Count = 3, 11, 12)
      .Borders(i).LineStyle = 1
      .Borders(i).Weight = IIf(i = 12, 1, 2)
    Next
  End With
End Sub

Hãy sửa thành:

Mã:

Sub SoTT(Rng As Range)
  Dim arr(), i As Long
  Rng.Resize(10000, 1).ClearContents
  ReDim arr(1 To Rng.Rows.Count, 1 To 1)
  For i = 1 To UBound(arr)
    arr(i, 1) = i
  Next
  Rng.Value = arr
End Sub
Sub DrawBorder(Rng As Range)
  On Error Resume Next
  Rng.Borders.LineStyle = 1
  Rng.Borders(12).Weight = 1
End Sub

Xem có cải thiện chút nào không?

Cá ngừ F1 · 12/7/14

ndu96081631 đã viết:

Chậm là do vụ Format mà ra.
Code của bạn là:

Mã:

Sub SoTT(Rng As Range)
  With Rng
    .Resize(10000, 1).Clear
    .Value = Evaluate("=row(R:R)")
    .NumberFormat = "00"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
  End With
End Sub 
Sub DrawBorder(Rng As Range)
  On Error Resume Next
  With Rng
    For i = 8 To IIf(Rng.Rows.Count = 3, 11, 12)
      .Borders(i).LineStyle = 1
      .Borders(i).Weight = IIf(i = 12, 1, 2)
    Next
  End With
End Sub

Hãy sửa thành:

Mã:

Sub SoTT(Rng As Range)
  Dim arr(), i As Long
  Rng.Resize(10000, 1).ClearContents
  ReDim arr(1 To Rng.Rows.Count, 1 To 1)
  For i = 1 To UBound(arr)
    arr(i, 1) = i
  Next
  Rng.Value = arr
End Sub
Sub DrawBorder(Rng As Range)
  On Error Resume Next
  Rng.Borders.LineStyle = 1
  Rng.Borders(12).Weight = 1
End Sub

Xem có cải thiện chút nào không?

Cải thiện hơn 1 nửa ạh
Mất hơn 2s chút

Quang_Hải · 12/7/14

Cá ngừ F1 đã viết:
Click... rẹt phát.. dưới 0.5s là PHÊ ạh...

Thử vầy xem có phê nổi không nha

PHP:

Sub FormatCif()
    Application.ScreenUpdating = False
    Dim data(), i, t
    t = Timer
    data = Range([A2], [A65536].End(3)).Value
    For i = 1 To UBound(data)
        data(i, 1) = i
    Next
    With [A2].Resize(i - 1)
        .Value = data
        .NumberFormat = "00"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With [A1:Z2]
        .Borders(xlInsideVertical).LineStyle = 1
        .Borders(xlInsideHorizontal).LineStyle = 2
        .Copy
        .Range("A1:Z" & i).PasteSpecial 4
    End With
    [A1:J1].Borders(xlEdgeTop).LineStyle = 1
    Range("A" & i & ":Z" & i).Borders(xlEdgeBottom).LineStyle = 1
    MsgBox Timer - t
    Application.ScreenUpdating = True
End Sub

Cá ngừ F1 · 12/7/14

ndu96081631 đã viết:

Chậm là do vụ Format mà ra.
Code của bạn là:

Mã:

Sub SoTT(Rng As Range)
  With Rng
    .Resize(10000, 1).Clear
    .Value = Evaluate("=row(R:R)")
    .NumberFormat = "00"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
  End With
End Sub 
Sub DrawBorder(Rng As Range)
  On Error Resume Next
  With Rng
    For i = 8 To IIf(Rng.Rows.Count = 3, 11, 12)
      .Borders(i).LineStyle = 1
      .Borders(i).Weight = IIf(i = 12, 1, 2)
    Next
  End With
End Sub

Hãy sửa thành:

Mã:

Sub SoTT(Rng As Range)
  Dim arr(), i As Long
  Rng.Resize(10000, 1).ClearContents
  ReDim arr(1 To Rng.Rows.Count, 1 To 1)
  For i = 1 To UBound(arr)
    arr(i, 1) = i
  Next
  Rng.Value = arr
End Sub
Sub DrawBorder(Rng As Range)
  On Error Resume Next
  Rng.Borders.LineStyle = 1
  Rng.Borders(12).Weight = 1
End Sub

Xem có cải thiện chút nào không?

Giải pháp này làm cho căn lề Số thứ tự không theo quy tắc, cái ở giữa, cái bên phải, cái bên trái... Do đó, code SoTT e điểu chỉnh lại thành:

Mã:

Sub SoTT(Rng As Range)
  Dim arr(), i As Long
  Rng.Resize(10000, 1).ClearContents
  Rng.NumberFormat = "00"
  Rng.HorizontalAlignment = xlCenter
  Rng.VerticalAlignment = xlCenter
  ReDim arr(1 To Rng.Rows.Count, 1 To 1)
  For i = 1 To UBound(arr)
    arr(i, 1) = i
  Next
  Rng.Value = arr
End Sub

P/S: tốc độ chỉ cải thiện đôi chút ạh

ndu96081631 · 12/7/14

Cá ngừ F1 đã viết:
Giải pháp này làm cho căn lề Số thứ tự không theo quy tắc, cái ở giữa, cái bên phải, cái bên trái... Do đó, code SoTT e điểu chỉnh lại thành:

Mã:

Sub SoTT(Rng As Range) Dim arr(), i As Long Rng.Resize(10000, 1).ClearContents Rng.NumberFormat = "00" Rng.HorizontalAlignment = xlCenter Rng.VerticalAlignment = xlCenter ReDim arr(1 To Rng.Rows.Count, 1 To 1) For i = 1 To UBound(arr) arr(i, 1) = i Next Rng.Value = arr End Sub

P/S: tốc độ chỉ cải thiện đôi chút ạh

Cái nào làm bằng tay được thì cứ làm, đừng quá lạm dụng code bạn à!
Dù sao thì chuyện canh trái phải ta cũng chỉ làm 1 lần, sao phải bắt code làm đi làm lại vậy?

Cá ngừ F1 · 12/7/14

ndu96081631 đã viết:
Cái nào làm bằng tay được thì cứ làm, đừng quá lạm dụng code bạn à!
Dù sao thì chuyện canh trái phải ta cũng chỉ làm 1 lần, sao phải bắt code làm đi làm lại vậy?

Dạ, vì là e có khớp thủ tục SoTT này vào thủ tục khác có đoạn:

Mã:

.Range("E" & EndR + 1 & ":U" & EndR + 1000).Clear

Để clear từ dòng cuối cùng + 1 đi, như thế định dạng bằng tay lại toi mất
Nên vẫn phải cho đoạn code canh trái phải vào ạh ?

ndu96081631 · 12/7/14

Cá ngừ F1 đã viết:
Dạ, vì là e có khớp thủ tục SoTT này vào thủ tục khác có đoạn:

Mã:

.Range("E" & EndR + 1 & ":U" & EndR + 1000).Clear

Để clear từ dòng cuối cùng + 1 đi, như thế định dạng bằng tay lại toi mất
Nên vẫn phải cho đoạn code canh trái phải vào ạh ?

Bạn có thể .Range("E" & EndR + 1 & ":U" & EndR + 1000).Clearclearcontents được mà (cùng lắm thêm phần xóa đóng khung)... như vậy thì phần canh lề trái phải vẫn được bảo toàn, đâu cần dùng code đê làm lại

Cá ngừ F1 · 12/7/14

ndu96081631 đã viết:
Bạn có thể .Range("E" & EndR + 1 & ":U" & EndR + 1000).Clearclearcontents được mà (cùng lắm thêm phần xóa đóng khung)... như vậy thì phần canh lề trái phải vẫn được bảo toàn, đâu cần dùng code đê làm lại

Phương thức clear có cái nào là clear phần xóa đóng khung không ạh?

Quang_Hải · 12/7/14

Cá ngừ F1 đã viết:
Phương thức clear có cái nào là clear phần xóa đóng khung không ạh?
View attachment 125326

Nhấp vô từng cái thử sẽ biết. Ai cũng học vậy mà.

ndu96081631 · 13/7/14

Cá ngừ F1 đã viết:
Phương thức clear có cái nào là clear phần xóa đóng khung không ạh?

Sao bạn không record macro để thí nghiệm.
Hoặc thử cái này xem:

Mã:

Range("gì gì đó").Borders.LineStyle = xlNone

vuivui85 · 13/7/14

Cá ngừ F1 đã viết:
Phương thức clear có cái nào là clear phần xóa đóng khung không ạh?
View attachment 125326

Cứ CLEAR cho nhanh và nhẹ files

áp dụng code này, khoảng 0.5s mà thôi (chỉnh sửa code quanghai1969 1 chút xíu là ngon ngay)

Mã:

Sub FormatCif()
    Application.ScreenUpdating = False
 
    Dim data(), i As Long, t, n As Long
    t = Timer
    n = [D65536].End(xlUp).Row
    Range("A" & n + 1 & ":Z65536").Clear
    
    With [A1:Z3]
        .Borders(xlInsideVertical).LineStyle = 1
        .Borders(xlEdgeTop).LineStyle = 1
        .Borders(xlEdgeLeft).LineStyle = 1
        .Borders(xlEdgeRight).LineStyle = 1
        .Borders(xlInsideHorizontal).LineStyle = 2
    End With
    With [A2]
        .NumberFormat = "00"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    [A2:Z2].Copy
    Range("A3:Z" & n).PasteSpecial 4
    [A1:Z2].Borders(xlInsideHorizontal).LineStyle = 1
    Range("A" & n & ":Z" & n).Borders(xlEdgeBottom).LineStyle = 1
    
    n = n - 1
    ReDim data(1 To n, 1 To 1)
    For i = 1 To n
        data(i, 1) = i
    Next
    [A2].Resize(n).Value2 = data
    
    
    Application.ScreenUpdating = True
    MsgBox Timer - t
End Sub

dangky47h · 9/7/18

ndu96081631 đã viết:
Sao bạn không record macro để thí nghiệm.
Hoặc thử cái này xem:

Mã:

Range("gì gì đó").Borders.LineStyle = xlNone

Thầy ơi, Em so sử dụng code :
Sub FormatCif()
Application.ScreenUpdating = False

Dim data(), i As Long, t, n As Long
t = Timer
n = [D65536].End(xlUp).Row
Range("A" & n + 1 & ":Z65536").Clear

With [A1:Z3]
.Borders(xlInsideVertical).LineStyle = 1
.Borders(xlEdgeTop).LineStyle = 1
.Borders(xlEdgeLeft).LineStyle = 1
.Borders(xlEdgeRight).LineStyle = 1
.Borders(xlInsideHorizontal).LineStyle = 2
End With
With [A2]
.NumberFormat = "00"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

[A2:Z2].Copy
Range("A3:Z" & n).PasteSpecial 4
[A1:Z2].Borders(xlInsideHorizontal).LineStyle = 1
Range("A" & n & ":Z" & n).Borders(xlEdgeBottom).LineStyle = 1

n = n - 1
ReDim data(1 To n, 1 To 1)
For i = 1 To n
data(i, 1) = i
Next
[A2].Resize(n).Value2 = data

Application.ScreenUpdating = True
MsgBox Timer - t
End Sub
E nhờ thầy sửa giúp em Viền nét đứt thay bằng nét đứt dạng khác như hình dưới ạ!
E cám ơn thầy

be_09 · 9/7/18

dangky47h đã viết:
Thầy ơi, Em so sử dụng code :
Sub FormatCif()
Application.ScreenUpdating = False

Dim data(), i As Long, t, n As Long
t = Timer
n = [D65536].End(xlUp).Row
Range("A" & n + 1 & ":Z65536").Clear

With [A1:Z3]
.Borders(xlInsideVertical).LineStyle = 1
.Borders(xlEdgeTop).LineStyle = 1
.Borders(xlEdgeLeft).LineStyle = 1
.Borders(xlEdgeRight).LineStyle = 1
.Borders(xlInsideHorizontal).LineStyle = 2
End With
With [A2]
.NumberFormat = "00"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

[A2:Z2].Copy
Range("A3:Z" & n).PasteSpecial 4
[A1:Z2].Borders(xlInsideHorizontal).LineStyle = 1
Range("A" & n & ":Z" & n).Borders(xlEdgeBottom).LineStyle = 1

n = n - 1
ReDim data(1 To n, 1 To 1)
For i = 1 To n
data(i, 1) = i
Next
[A2].Resize(n).Value2 = data

Application.ScreenUpdating = True
MsgBox Timer - t
End Sub
E nhờ thầy sửa giúp em Viền nét đứt thay bằng nét đứt dạng khác như hình dưới ạ!
E cám ơn thầyView attachment 199135

Đã mở Topic bên kia hỏi rồi, nêu rõ thì tôi có hiểu mới làm giúp chứ.
Sao lại hỏi tiếp ở đây nữa (coi chừng vi phạm nội quy).
https://www.giaiphapexcel.com/diend...ề-Định-dạng-lại-đường-viền-trong-bảng.136024/

dangky47h · 9/7/18

be09 đã viết:
Đã mở Topic bên kia hỏi rồi, nêu rõ thì tôi có hiểu mới làm giúp chứ.
Sao lại hỏi tiếp ở đây nữa (coi chừng vi phạm nội quy).
https://www.giaiphapexcel.com/diend...ề-Định-dạng-lại-đường-viền-trong-bảng.136024/

Vâng ạ! e rút kinh nghiệm hi

Cải thiện tốc độ đánh số tự động và định dạng bảng tính (1 người xem)

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

( ͡° ͜ʖ ͡°)

File đính kèm

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

Huyền thoại GPE

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

Huyền thoại GPE

( ͡° ͜ʖ ͡°)

Huyền thoại GPE

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

Huyền thoại GPE

Thành viên mới

Thành viên thường trực

Biên Hòa, Đồng Nai

Thành viên thường trực

Đếm ngược thời gian