Как преобразовать столбец A в текст на нескольких листах

Question

Если я вручную изменю ячейку с номера на текст, она изменится с 784768956303 на 7.84769E + 11

Поэтому в настоящее время я использую приведенный ниже код для преобразования числового поля в текст на рабочем листе, которым я сейчас занимаюсьна.

Const MaxTextLength = 255

Sub ConvertColumnAtoText()
'    StartNewTask "Converting all cells to text"
    Application.ScreenUpdating = False

    Dim MyRange As Range
    Set MyRange = ActiveSheet.UsedRange.Columns("A")
    Dim cache() As Long
    cache = GetColumnWidths(MyRange)

    With MyRange
        .ColumnWidth = MaxTextLength
        Dim Values() As Variant
        ReDim Values(.Rows.Count, .Columns.Count)

        Dim col As Long
        Dim row As Long

        For row = 0 To UBound(Values, 1)
            For col = 0 To UBound(Values, 2)
                Dim temp As String
                temp = .Cells(row + 1, col + 1).Text
                If Len(temp) <= MaxTextLength Then
                    Values(row, col) = temp
                End If
            Next col
        Next row
        .NumberFormat = "@"
    End With

    MyRange = Values
    SetColumnWidths MyRange, cache
    Application.ScreenUpdating = True
End Sub

Private Function GetColumnWidths(Target As Range) As Long()
    Dim output() As Long
    ReDim output(1 To Target.Columns.Count)
    Dim index As Long
    For index = 1 To Target.Columns.Count
        output(index) = Target.Columns(index).ColumnWidth
    Next index
    GetColumnWidths = output
End Function

Private Sub SetColumnWidths(Target As Range, widths() As Long)
    Dim index As Long
    For index = LBound(widths) To UBound(widths)
        Target.Columns(index).ColumnWidth = widths(index)
    Next index
End Sub

Это кажется немного излишним, но если бы я использовал

Columns("A:A").NumberFormat = "@"

ИЛИ

[A:A].Select
With Selection
Dim col As Long
    .NumberFormat = "@"
    .Value = .Value
End With

Я все равно получил 7,84769E + 11

Я хотел бы иметь возможность запустить скрипт для преобразования используемого диапазона в столбце А на 3 различных листах

Я знаю, мне нужно изменить этот бит

Set MyRange = ActiveSheet.UsedRange.Columns("A")

НоЯ считаю, что у меня не может быть диапазона, охватывающего несколько листов.

После того, как все это заработает, я бы хотел добавить это к кнопке, которая уже вызывает 3 разных макроса, и запускать все последовательно один раз за предыдущиймакрос завершен.

Sub Button1_Click()
    Call courier1 'Macro1
    Call courier2 'Macro2
    Call courier3 'Macro3
    MsgBox "Done"
End Sub

Однако мой исходный код выше имеет 2 SUB и функцию (один SUB и функцию Private).Нужно ли мне изменить кнопку на

Sub Button1_Click()
    Call courier1 'Macro1
    Call courier2 'Macro2
    Call courier3 'Macro3
    Call ConvertColumnAtoText
    Application.Run "GetColumnWidths"
    Application.Run "SetColumnWidths"
    MsgBox "Done"
End Sub

Спасибо

Answer 1

Предполагая, что в вашем файле Excel есть только 3 листа, которые вам нужно пройти, приведенный ниже код будет перебирать все листы:

Sub ConvertColumnAtoText()
'    StartNewTask "Converting all cells to text"
    Application.ScreenUpdating = False

    Dim WS As Worksheet 'new line added

    Dim MyRange As Range

    For Each WS In Worksheets ' new line added

        WS.Activate ' new line added

        Set MyRange = ActiveSheet.UsedRange.Columns("A")
        Dim cache() As Long
        cache = GetColumnWidths(MyRange)


        With MyRange
            .ColumnWidth = MaxTextLength
            Dim Values() As Variant
            ReDim Values(.Rows.Count, .Columns.Count)

            Dim col As Long
            Dim row As Long

            For row = 0 To UBound(Values, 1)
                For col = 0 To UBound(Values, 2)
                    Dim temp As String
                    temp = .Cells(row + 1, col + 1).Text
                    If Len(temp) <= MaxTextLength Then
                        Values(row, col) = temp
                    End If
                Next col
            Next row
            .NumberFormat = "@"
        End With

        MyRange = Values
        SetColumnWidths MyRange, cache
    Next WS ' new line added

    Application.ScreenUpdating = True
End Sub

Относительно вашего другого