Переберите все рабочие листы в рабочей книге и измените число, сохраненное в виде текста, на число

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