遍历工作簿中的所有工作表，并将存储为文本的数字更改为数字

Question

下面的代码循环遍历工作表，并将指定的范围更改为数字格式，并将范围乘以常量以删除以文本格式存储的数字。

我遇到的问题是它将整个范围乘以1，这会在范围之后留下空零的踪迹。

我尝试创建一个找到最后一行的变量，但无济于事，尾随的零仍然存在。我很感激你的帮助。

Sub copy_paste()
Dim ws As Worksheet
Dim rConst As Range
Dim lrow As Long

Application.ScreenUpdating = False
Set rConst = Cells(40, 40)
rConst = 1

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "GA_AVERAGE" Then
        lrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
        ws.Range("D1:F" & lrow).NumberFormat = "0"
        ws.Range("M1:N" & lrow).NumberFormat = "0"
        rConst.Copy

        ws.Range("D1:F" & lrow).PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply
        ws.Range("M1:N" & lrow).PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply


End If
    Next ws


rConst.Clear


Application.ScreenUpdating = True
End Sub

Answer 1

试试这个：

Sub test()
    Dim wb As Excel.Workbook
    Dim ws As Worksheet
    Dim lrow As Long
    Dim rng As Range

    Application.ScreenUpdating = False
    Set wb = Workbooks("Book1") 'change to your workbook name

    For Each ws In wb.Worksheets
        If ws.Name <> "GA_AVERAGE" Then
            lrow = ws.Cells(ws.Cells.Rows.count, "A").End(xlUp).row
            Set rng = ws.Range("D1:F" & lrow & ", " & "M1:N" & lrow)
            rng.NumberFormat = "0"
            For Each cel In rng
                If cel.Value <> vbNullString Then cel.Value = cel.Value * 1
            Next
            Set rng = Nothing
        End If
    Next ws

    Application.ScreenUpdating = True
End Sub

/ e：我建议你设置一个工作簿，以确保你参考最正确的工作簿和工作表;编辑了代码

/ e2：我看到你在这里做了什么！对于大型电子表格，您的方法效率更高。下面是另一种方法，这是丑陋但有效，所有都在评论中解释。此方法将保留现有的零并将它们转换为数字，并且不会创建新的不需要的零：

Sub test()
    Dim wb As Excel.Workbook
    Dim ws As Worksheet
    Dim lrow As Long
    Dim rng As Range
    Dim tempStr As String, origVal As String

    Application.ScreenUpdating = False

    Set wb = Workbooks("Book3") 'change to your workbook name
    tempStr = "tempStr"

    For Each ws In wb.Worksheets
        If ws.Name <> "GA_AVERAGE" Then
            lrow = ws.Cells(ws.Cells.Rows.count, "A").End(xlUp).row
            Set rng = ws.Range("D1:F" & lrow & ", " & "M1:N" & lrow)
            With rng
                'first, replace original blank cells with random string to keep them blank, otherwise they will appear as 0
                .Replace What:=vbNullString, Replacement:=tempStr
                'change format to number
                .NumberFormat = "0"
                'remember value to retrieve it later
                origVal = ws.Range("A1").Value
                'this is the value used for xlPasteSpecialOperationMultiply
                ws.Range("A1").Value = 1
                ws.Range("A1").Copy
                'multiply range by 1
                rng.PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply
                'retrieve original value of A1
                ws.Range("A1").Value = origVal
                'retrieve original blank cells
                .Replace What:=tempStr, Replacement:=vbNullString
            End With
            tempStr = Empty
            origVal = Empty
            Set rng = Nothing
        End If
    Next ws

    Application.ScreenUpdating = True
End Sub

要在电子表格中查找包含数据的最后一行，您可以使用代码打击;如果电子表格为空，则会出错，将wb.Sheets(1)替换为您的wb和工作表

lrow = wb.Sheets(1).Cells.Find(What:="*", After:=wb.Sheets(1).Range("A1"), SearchDirection:=xlPrevious).row