Excel 更新代码以复制粘贴值(无公式)

Excel 更新代码以复制粘贴值(无公式),excel,vba,Excel,Vba,我如何更新下面的代码以复制粘贴到值中的新工作表“day\u week”?当单元格位于公式中时,询问是因为给出了错误,所以我想将单元格内容转换为值 Sub dayweek() Dim i As Integer Dim Ws As Worksheet, cs As Worksheet Set Ws = Sheets("Incidents_data") Ws.Select Ws.Range("r2", Ws.Range("r2").End(xlDown))

我如何更新下面的代码以复制粘贴到值中的新工作表“day\u week”?当单元格位于公式中时,询问是因为给出了错误,所以我想将单元格内容转换为值

Sub dayweek()

    Dim i As Integer
    Dim Ws As Worksheet, cs As Worksheet

    Set Ws = Sheets("Incidents_data")
    Ws.Select

    Ws.Range("r2", Ws.Range("r2").End(xlDown)).Select     'Update for different data column
    Selection.Copy


    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Day_week"               'Update for different data column
    Set cs = Sheets("Day_week")                 'Update for different data column

    cs.Range("A2").Select
    cs.Paste
    Application.CutCopyMode = False
    cs.Range("A2", cs.Range("A2").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    cs.Range("A1") = Ws.Range("r1").Value          'Update for different data column (only ws.Range("A1").Value) (this is just the column heading)
    cs.Range("B1") = "Number of occurrences"

    For i = 1 To cs.Range("A2", cs.Range("A2").End(xlDown)).Rows.Count
        cs.Cells(1 + i, 2) = Application.CountIf(Ws.Range("r2", Ws.Range("r2").End(xlDown)), cs.Cells(1 + i, 1))          'Update for different data column
    Next i

    cs.Range(cs.Cells(2, 1), cs.Cells(cs.Range("A2").End(xlDown).Row, 2)).Sort Key1:=cs.Range("B1"), order1:=xlDescending, Header:=xlNo

End Sub

如下面所示更改代码。代码中的注释

Sub dayweek()

    Dim i As Integer
    Dim data As Variant
    Dim destinationRange As Range
    Dim Ws As Worksheet, cs As Worksheet

    Set Ws = Sheets("Incidents_data")

    'This is redundant. You don't need to activate worksheet
    'in order to get data from it.
    'Ws.Select

    'Since you said you need only values (without formulas nor
    'formatting), instead of copying cells, we copy only their content.
    data = Ws.Range("r2", Ws.Range("r2").End(xlDown))

    'Ws.Range("r2", Ws.Range("r2").End(xlDown)).Select     'Update for different data column
    'Selection.Copy



    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Day_week"               'Update for different data column
    Set cs = Sheets("Day_week")                 'Update for different data column


    'Again, you don't need to activate worksheet to paste data in it.
    'cs.Range("A2").Select
    'cs.Paste
    Set destinationRange = cs.Range("A2").Resize(UBound(data, 1), UBound(data, 2))
    destinationRange = data


    Application.CutCopyMode = False
    cs.Range("A2", cs.Range("A2").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    cs.Range("A1") = Ws.Range("r1").Value          'Update for different data column (only ws.Range("A1").Value) (this is just the column heading)
    cs.Range("B1") = "Number of occurrences"

    For i = 1 To cs.Range("A2", cs.Range("A2").End(xlDown)).Rows.Count
        cs.Cells(1 + i, 2) = Application.CountIf(Ws.Range("r2", Ws.Range("r2").End(xlDown)), cs.Cells(1 + i, 1))          'Update for different data column
    Next i

    cs.Range(cs.Cells(2, 1), cs.Cells(cs.Range("A2").End(xlDown).Row, 2)).Sort Key1:=cs.Range("B1"), order1:=xlDescending, Header:=xlNo

End Sub

我不确定在新工作表中引入格式有多重要,但与复制、粘贴特殊值相比,直接值传输是一种更有效的方法

我已减少了代码对
的依赖。请选择
ActiveSheet
,而宁愿依赖指定的工作表变量和工作表的父工作表引用

Sub dayweek()
Dim i为长,csName为字符串
将Ws作为工作表,cs作为工作表
csName=“日/周”
Sub dayweek()

    Dim i As Long, csName As String
    Dim Ws As Worksheet, cs As Worksheet

    csName = "Day_week"  '<~~ 'Update for different data column IN ONE PLACE
    With Sheets.Add(After:=Sheets(Sheets.Count))
        .Name = csName
    End With
    Set cs = Sheets(csName)

    Set Ws = Sheets("Incidents_data")

    With Ws
        With .Range("r2", .Range("r2").End(xlDown))      'Update for different data column
            cs.Range("A2").Resize(.Rows.Count, .Columns.Count) = .Value
        End With
    End With

    With cs
        .Range("A1:B1") = Array(Ws.Range("A1").Value, "Number of occurrences")
        With .Range("A2", .Range("A2").End(xlDown))
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
        'restate this as it may have changed rows
        With .Range("A2", .Range("A2").End(xlDown))
            .Offset(0, 1).Formula = "=COUNTIF(A:A, A2)"
            .Value = .Value
        End With
        With .Range("A1").CurrentRegion
            .Cells.Sort Key1:=.Columns(2), Order1:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
        End With
    End With


End Sub