andythuy
Thành viên mới
- Tham gia
- 24/8/10
- Bài viết
- 41
- Được thích
- 2
Chào các bác,
Em có viết một đoạn mã để thực hiện các việc sau:
1. Tạo một sheet mới trong workbook hiện hành
2. Định dạng chiều cao dòng và loại font cho các dòng ở sheet mới cho khớp với các miếng dán trên giấy Tomy133
3. Copy dữ liệu trong các cột do người dùng chỉ định ở worksheet hiện hành sang worksheet mới
Tuy nhiên, đoạn mã này chạy rất chậm, mặc dù em thấy toàn các lệnh đơn giản, các bác xem giúp nó cần tối ưu như thế nào và tư vấn cho em với nhé
Em có viết một đoạn mã để thực hiện các việc sau:
1. Tạo một sheet mới trong workbook hiện hành
2. Định dạng chiều cao dòng và loại font cho các dòng ở sheet mới cho khớp với các miếng dán trên giấy Tomy133
3. Copy dữ liệu trong các cột do người dùng chỉ định ở worksheet hiện hành sang worksheet mới
Tuy nhiên, đoạn mã này chạy rất chậm, mặc dù em thấy toàn các lệnh đơn giản, các bác xem giúp nó cần tối ưu như thế nào và tư vấn cho em với nhé
Mã:
ub tomy133()
Dim checksheetname As Boolean
Dim Vung As Range
Dim iCell As Range
Dim BoDem As Integer
'ws As Sheets
'
' Macro1 Macro
'
'
On Error GoTo errHandler:
'Cho user chon vung du lieu de in Label
Set Vung = Application.InputBox("Chon cac o chua SO LIEU de in", "Chon CELL can in LABEL", , , , , , 8)
'kiem tra xem có sheet tomy133 chua, neu chua co thi tao
checksheetname = False
For Each ws In Worksheets
If ws.Name = "tomy133" Then
checksheetname = True
MsgBox ("Sheet da ton tai")
Exit For
End If
Next ws
If checksheetname = False Then
'tao sheet tomy133
Worksheets.Add
ActiveSheet.Name = "tomy133"
End If
Sheets("tomy133").Activate
Rows("1:24").Select
Selection.RowHeight = 51.75
Selection.Font.Name = "Free 3 of 9 Extended"
Selection.Font.Size = 30
Selection.VerticalAlignment = xlBottom
'------------
Columns("A:A").Select
Selection.ColumnWidth = 46
Columns("B:B").ColumnWidth = 6
Columns("C:C").ColumnWidth = 46
'-----
Rows("1:1").Select
Selection.RowHeight = 47.25
Rows("2:2").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
Rows("5:5").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
Rows("8:8").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
Rows("11:11").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
Rows("14:14").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
Rows("17:17").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
Rows("20:20").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
Rows("23:23").Select
Selection.RowHeight = 22.5
Selection.Font.Name = "Arial"
Selection.Font.Size = 20
'--------------
Rows("3:3").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
Rows("6:6").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
Rows("9:9").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
Rows("12:12").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
Rows("15:15").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
Rows("18:18").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
Rows("21:21").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
Rows("24:24").Select
Selection.RowHeight = 30.75
Selection.Font.Name = "Arial"
Selection.Font.Size = 22
Selection.VerticalAlignment = xlTop
'------------
'Chon font arial va size 22 Free 3 of 9 Extended
'Cells.Font.Name = "Arial"
'Cells.Font.Size = 22
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
'.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
'
'Cai dat trang
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
BoDem = 1
For Each iCell In Vung
If BoDem <= 8 Then
Range("A" & BoDem * 3 - 2).Value = "*" & iCell.Value & "*"
Range("A" & BoDem * 3 - 1).Value = iCell.Value2
Range("A" & BoDem * 3).Value = iCell.Offset(, 2).Value2
Else
If BoDem <= 16 Then
'BoDem = BoDem + 1
Range("C" & (BoDem - 8) * 3 - 2).Value = "*" & iCell.Value & "*"
Range("C" & (BoDem - 8) * 3 - 1).Value = iCell.Value2
Range("C" & (BoDem - 8) * 3).Value = iCell.Offset(, 2).Value2
Else
Exit For
End If
End If
iCell.Font.Color = -11489280
BoDem = BoDem + 1
Next iCell
MsgBox "Done"
errHandler: Exit Sub
End Sub
