Question

我有一本包含大量工作表的工作簿。我只在标有!的工作表上工作。我想按值替换所有公式，并将工作表存储为自己的.xls文件。我的脚本正是这样做的。我的问题是原始文档也受到影响。有没有办法只在复制的纸张上替换值，这些值将被存储，以便原始文档保持不变？

Dim wbk As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim cl As Object
Dim xPath As String
Dim isReadable As Boolean
Dim sName As String
xPath = Application.ActiveWorkbook.Path

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
On Error Resume Next

Set wbk = ActiveWorkbook

For Each ws In wbk.Sheets
    isReadable = (InStr(ws.Name, "!")) > 0

    If isReadable Then
        Debug.Print ws.Name

        Set rng = ws.Range("A1").SpecialCells(xlCellTypeFormulas, 23)
        If Not (rng Is Nothing) Then
            For Each cl In rng
                cl.Value = cl.Value
            Next cl
        End If

        sName = Replace(ws.Name, "!", "")
        sName = LCase(Replace(sName, "+", ""))

        ws.Copy

        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & sName & ".xlsx", CreateBackup:=False
        Application.ActiveWorkbook.Close False

        Debug.Print sName
    End If

Next ws
Application.Calculate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Done, do not save the changes!"

Answer 1

复制工作表并对其进行处理：

Sub DoStuff()

Dim wsOrig As Worksheet
Dim wsNew As Worksheet
Dim wbOrig As Workbook
Dim wbNew As Workbook

Set wsOrig = ActiveSheet ' or whatever
Set wbOrig = ActiveWorkbook ' or whatever

For s = 1 To wbOrig.Sheets.Count

    If wbOrig.Sheets(s) ' meets my conditions then....

        Application.SetWarnings False ' don't question if we want to delete thinsg

        Set wbNew = Workbooks.Add
        wsOrig.Copy After:=wbNew.Sheets(1)

        wbNew.Sheets(1).Delete ' delete the default Sheet1 of the new workbook
        Set wsNew = wbNew.Sheets(1)

        With wsNew

            ' do all the stuff I want to do

        End With

        wbNew.SaveAs ' whatever

        Application.SetWarnings True

    End If

Next s

End Sub

Answer 2

以下是另一种仅在复制的工作表上进行更改的方法：

$ python3
Python 3.5.2 (default, Nov 17 2016, 17:05:23) 
[GCC 5.4.0 20160609] on linux
Type "help", "copyright", "credits" or "license" for more information.
>>> A=[[0,1,0],[0,0,1],[0,1,0],[1,0,0],[1,0,0]]
>>> dic = {}
>>> B = []
>>> for idx,row in enumerate(A,1):
...     trow = tuple(row)
...     if trow not in dic:
...         dic[trow] = len(dic)
...         B.append([idx])
...     else:
...         B[dic[trow]].append(idx)
... 
>>> B
[[1, 3], [2], [4, 5]]

Excel宏：替换公式并将工作表另存为自己的文件而不更改原始文档

2 个答案: