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