Question

嗨我从网上获得了一个代码，根据我的要求工作正常，但是在运行宏之后，格式化会受到干扰，就像行大小一样，列大小不像复制那样。最重要的是，在新的工作表中，列冻结正在解冻。我想格式化，因为它是在新创建的表格，包括冷冻窗格。请帮忙。代码如下。

Sub columntosheets（）

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim sname As String
Dim sh As Worksheet

Const s As String = "A" 'change to whatever criterion column
Dim d As Object, a, cc&
Dim p&, i&, rws&, cls&


sname = ActiveSheet.Name ' It is mandatory to have the OS sheet as active and then run this code.

Set d = CreateObject("scripting.dictionary")
With Sheets(sname)
    rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    cc = .Columns(s).Column
End With

For Each sh In Worksheets
    d(sh.Name) = 1
Next sh


With Sheets.Add(After:=Sheets(sname))
    Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
    .Cells(1).Resize(rws, cls).Sort .Cells(cc), xlDescending, Header:=xlYes
    a = .Cells(cc).Resize(rws + 1, 1)
    p = 3
    For i = 3 To rws + 1
        If a(i, 1) <> a(p, 1) Then
            If d(a(p, 1)) <> 1 Then
                Sheets.Add.Name = a(p, 1)
                .Cells(1).Resize(2, cls).Copy Cells(1)
                .Cells(p, 1).Resize(i - p, cls).Copy Cells(3, 1)
            End If
            p = i
        End If
    Next i
    .Delete
End With
Sheets(sname).Activate

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

而不是使用以下方式创建新工作表：

With Sheets.Add(After:=Sheets(sname))

保持模板表可用。模板表可以具有正确大小的行和列。它还可以预设标题和格式。

您需要做的就是复制模板表并根据需要填写。

Answer 2

您的代码正在指导调整大小;只需删除代码的每个部分。即。

Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)

到

Sheets(sname).Cells(1).Copy .Cells(1)

运行vba宏后如何保持格式化？

2 个答案: