Question

我如何更新以下代码以将粘贴复制到值中的新表“day_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

Answer 1

更改您的代码，如下所示。代码中的评论。

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

Answer 2

我不确定将格式化带到新工作表的重要性，但直接值传输是一种更有效的方法，而不是复制，粘贴特殊值。

我减少了代码对.Select和ActiveSheet的依赖，而宁愿依赖于分配的工作表变量和https://github.com/nbs-system/naxsi/wiki/whitelists的父工作表引用。

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

如果格式化是关键任务，则可以进行后续复制，粘贴特殊格式操作。

_{有关远离依赖选择和激活以实现目标的更多方法，请参阅With ... End With statement。}

更新代码以复制粘贴值（无公式）

2 个答案: