- 帖子
- 132
- 主題
- 56
- 精華
- 0
- 積分
- 190
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 365
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-5-17
- 最後登錄
- 2025-4-8
|
回復 2# GBKEE
我也有一段巨集該如簡化?
Private Sub format()
Dim ws As Worksheet
Dim sName As String
sName = "PTAVS"
On Error Resume Next
Set ws = Sheets(sName)
If ws Is Nothing Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = sName
ws.Activate
Else
MsgBox sName & "工作表已存在。"
Sheets("Result").Select
Exit Sub
End If
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("B1:M1").Merge
Range("A1:A4").Select
With Selection
.WrapText = False
.MergeCells = True
.Value = "C1~C5"
End With
Range("B2:G2").Select
With Selection
.WrapText = False
.MergeCells = True
.Value = "(sone)"
End With
Range("B3:D3").Select
With Selection
.WrapText = False
.MergeCells = True
.Value = "H"
End With
Range("E3:G3").Select
With Selection
.WrapText = False
.MergeCells = True
.Value = "M"
End With
Range("B4:G4").Select
With Selection
.WrapText = True
.MergeCells = False
End With
Range("B4").Value = "mean"
Range("C4").Value = "standard deviation"
Range("D4").Value = "mean+CV*stdev"
Range("B4:D4").Copy
Range("E4").Select
ActiveSheet.Paste
Range("B2:G4").Copy
Range("H2").Select
ActiveSheet.Paste
Range("H2").Value = "(tu)"
Range("A1:M4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Font
.Name = "Arial"
.Size = 10
End With
Sheets("Result").Select
End Sub
'-------------------------------------
這段code有很大的部分是在做儲存格的合併以及畫框線 這該如何簡化呢? |
|