EXCEL VBA复制含公式数据源替换为数值

最新推荐文章于 2024-07-03 11:22:14 发布

Check_Const

最新推荐文章于 2024-07-03 11:22:14 发布

阅读量3.6k

点赞数

文章标签： excel

本文链接：https://blog.csdn.net/Check_Const/article/details/128131246

版权

方式一：.PasteSpecial Paste:=xlPasteValues
Sub Copy_Values()  '选择性粘贴为数值
    Dim v_Rows As Long   '行号
    Dim v_col As Integer '列号

    'Sheets("Sheet1").Select  '工作表 选择方式一
    Sheets(1).Select          '工作表 选择方式二
    
    v_col = 1
    If Cells(1, v_col).Value < 30 Then    '列第1个单元格值条件
       'Columns(1).Select
       'Sheets("Sheet1").Columns(1).Copy  '整列拷贝方式之一，较少用
       
       v_Rows = Sheets(1).UsedRange.Cells(Sheets(1).UsedRange.Rows.Count, v_col).Row  '最后一个非空单元格行号
       With Worksheets(1)
          '连带公式复制 '.Range(.Cells(1, v_col), .Cells(v_Rows, v_col)).Copy .Range(.Cells(1, v_col), .Cells

(v_Rows, v_col))
          
          '以下两句粘贴为数值操作
          .Range(.Cells(1, v_col), .Cells(v_Rows, v_col)).Copy  '粘贴为数值 先拷贝
          
          '选择性粘贴为数值
          .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          
       End With
    End If
    
    Sheets(1).Range("B1").Select
    Application.CutCopyMode = False '清空剪贴板
    Application.ScreenUpdating = True
    
    MsgBox "拷贝为数值完成", vbInformation, "提示"
End Sub


方式二：使用数组
Sub CheckCell()
  Dim v_Rows As Long  '行数变量
  Dim i As Long       '循环变量
  Dim col_1 As Integer  '数据所在列号
  Dim v_Array() As String  '数组

  'v_Rows = [A65536].End(xlUp).Row  '取行数 方式之一
  col_1 = 1  '测试列号
  v_Rows = ActiveSheet.Cells(Rows.Count, col_1).End(xlUp).Row  '对应列最后一个非空单格行号

  ReDim v_Array(1 To v_Rows)  '根据行数调整数组大小

  If Cells(1, 1).Value < 19 Then
     For i = 1 To v_Rows
        v_Array(i) = Cells(i, 1)   '单元格内容赋给数组
     Next i
  
     For i = 1 To v_Rows
        Cells(i, col_1).Value = v_Array(i)  '数组内容填回单元格
     Next i
  
     MsgBox "第" & col_1 & "列 " & v_Rows & "行 覆盖RANDBETWEEN()完成", vbOKOnly, "提示"
  Else
     MsgBox "第" & col_1 & "列 " & v_Rows & "行 数据未调整", vbExclamation, "提示"
  End If

End Sub