Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Range (Cells)


Rambler's Top100


Counter CO.KZ


    [1] [2] [3] [4] [5] [6]

  1. Как автоматически создать список, содержащий скопированный в буфер обмена текст ? 05.11.2017
  2. Как автоматически создать архив всех изменений, для всех ячеек нужного рабочего листа ? 04.02.2018
  3. Как после изменения данных, отменить все изменения, если хотя бы в одной из ячеек, количество символов превысит допустимое ? 10.02.2018
  4. Как синхронизировать две и более ячейки ? NEW 10.05.2018
  5. Как разрешить пользователю вводить дату, где разделителем будет запятая ? NEW 10.06.2018
  6. Как разрешить пользователю вводить время, где разделителем будет запятая ? NEW 12.06.2018
  7. Как разрешить пользователю вводить дату, но без разделитей ? NEW 11.06.2018
  8. Как выбрать случайную ячейку из указанного диапазона ? NEW 21.05.2018
  9. Как сохранить данные ячеек, содержащих текст, в текстовый файл, причём данные ячеек, где использовался ALT+ENTER, необходимо также разбить по строкам ? NEW 01.07.2018
  10. Как убрать пустые ячейки из определённого диапазона ? NEW 19.01.2019
  11. Как удалить столбцы с определенным заголовком ? NEW 18.01.2019
  12. Как в конкретном диапазоне ячеек удалить пробел(ы) в начале и в конце текста ? NEW 08.05.2019
    [1] [2] [3] [4] [5] [6]


  • Ответ : Скачать пример

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

    Да, и обратите внимание, что копировать текст можно не только в Excel, проще говоря, пользователь может осуществлять копирование и в других программах. Однако в этом случае, если количество символов в скопированном тексте будет превышать 32767, то этот текст будет "разбит", ибо ячейка в Excel не может содержать большее количество символов.
  • 'Необходима следующая ссылка Microsoft Forms 2.0 Object Library
    
    Public iClipboard As New MSForms.DataObject, iRow&
    
    Public Sub StartCopyTextFromClipboard()
        Range("A:A").Clear
        CopyTextFromClipboard
    End Sub
    
    Public Sub CopyTextFromClipboard()
        If Application.ClipboardFormats(1) = xlClipboardFormatText Then
           iClipboard.GetFromClipboard
           iText$ = iClipboard.GetText(1)
           For iCount& = 1 To Len(iText$) Step 32767
               iRow& = iRow& + 1
               Cells(iRow&, 1) = Mid(iText$, iCount&, 32767)
           Next
           iClipboard.SetText "", 1
           iClipboard.PutInClipboard
        End If
        Application.OnTime DateAdd("s", 1, Now), "CopyTextFromClipboard"
    End Sub
    
    Public Sub StopCopyTextFromClipboard()
        On Error Resume Next
        Application.OnTime DateAdd("s", 1, Now), "CopyTextFromClipboard", , False
    End Sub

    Если же задача, в принципе, таже, но заполнять нужно только пустые ячейки конкретного диапазона (в примере это A1:C3), т.е. до выполнения макроса, некоторые ячейки уже могут быть заполнены и данные этих ячеек нужно оставить, а прекратить всё необходимо, как только все ячейки будут заполнены, то :
    'Необходима следующая ссылка Microsoft Forms 2.0 Object Library
    
    Public iClipboard As New MSForms.DataObject
    
    Public Sub CopyTextFromClipboard()
        Dim iSource As Range, iCell As Range, iText$
    
        On Error Resume Next
        iClipboard.GetFromClipboard: iText = iClipboard.GetText(1)
    
        If iText <> "" Then 'If Len(iText) > 0 Then
           Set iSource = ThisWorkbook.Worksheets(1).Range("A1:C3")
           Set iCell = iSource.Find("", , xlFormulas, xlWhole) ', xlByRows)
    
           If Not iCell Is Nothing Then
              iCell.Value = Left(iText, 32767)
              iClipboard.SetText "", 1: iClipboard.PutInClipboard
              Application.OnTime DateAdd("s", 1, Now), "CopyTextFromClipboard"
           End If
        End If
    End Sub

  • Ответ :

    Если Вам необходимо, чтобы после каждого изменения (ввод/редактирование/вставка/удаление) в любой из ячеек определённого рабочего листа, все изменения сохранялись в текстовый файл, то просто разместите нижеопубликованный код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        If Target.Count > 1 Then Exit Sub
        
        Open ThisWorkbook.Path & "\" & Target.Address For Append As #1
             Print #1, Now, Target.Value 'Target.Formula
        Close #1
    End Sub
    Комментарий : Обратите внимание на то, что данные каждой ячейки - сохраняются в свой(отдельный) текстовый файл. Причём, несмотря на отсутствие расширения, это именно текстовый файл, так что Вы можете просматривать его. Если же Вы считаете, что расширение обязательно необходимо, то просто добавьте к адресу ячейки & ".txt"

    Примечание : Если подобная архивация данных должна происходить только для ячеек определённого диапазона, то смотрите следующий совет [FAQ99]
  • Ответ : Актуально для MS Excel 97-2007

    Если Вам необходимо сразу после изменения данных (ввод, вставка скопированных/вырезаных данных) определить есть ли ячейка, где количество символов превышает максимально допустимое пользователем. И в случае наличия такой ячейки, отменить все произошедшие изменения, то разместите один из двух нижеопубликованных кодов в модуле нужного рабочего листа [FAQ31], только не забудьте указать свой лимит количества символов, в примерах, это 285
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        Dim maxLength As Variant
        maxLength = Evaluate("MAX(LEN(" & Target.Address(, , Application.ReferenceStyle) & "))")
        
        If IsError(maxLength) Then Exit Sub
        'Причин неудач(ошибки) может быть несколько :
        '1) В диапазоне есть ячейки, содержащие значение ошибки
        '2) Изменения произошли в диапазоне включающем целый столбец(ы)
            
        If maxLength > 285 Then
           Application.EnableEvents = False
           Application.Undo
           Application.EnableEvents = True
        End If
    End Sub
    Private Const LimitChar = 285
    
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        Dim iSource As Range, iMask$
        iMask = String(LimitChar + 1, "?") & "*"
        
        For Each iSource In Target.Areas
            If Application.CountIf(iSource, iMask) > 0 Then
               Application.EnableEvents = False
               Application.Undo
               Application.EnableEvents = True
               Exit Sub
            End If
        Next
    End Sub
    Комментарий : Обратите внимание, на самом деле, оба варианта, определяют не количество символов в ячейке (свойство .Formula), а какое количество символов содержит значение ячейки (свойство .Value) Иначе говоря, если ячейка будет содержать формулу, например, =A1 а в ячейке A1 будет находиться этот комментарий, то количество символов в ячейке = 3 но оба варианта будут считать длину этого комментария, т.е. = 413

    Если сие неприемлимо и нужно ограничить именно количество символов в ячейке, то используйте третий вариант, не забывая, что метод Find не позволяет искать более 255 символов, а т.к. мы ищем на один символ больше, то наш лимит 254
    Private Const LimitChar = 100 'Максимум 254
    
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        If Not Target.Find(String(LimitChar + 1, "?"), , xlFormulas) Is Nothing Then
           Application.EnableEvents = False
           Application.Undo
           Application.EnableEvents = True
        End If
    End Sub

  • Ответ :

    Если Вам необходимо сихнхронизировать одну ячейку, т.е., сделать так, чтобы при любом изменении данных, например, в ячейке A1 в C10 были те же данные, достаточно ввести в ячейку C10 ссылку =A1 и не устанавливать ручной пересчёт. Но если такой финт необходимо проделать для двух(и более) ячеек, то банальная ссылка не подойдёт. Впрочем, не всё так безнадежно, ибо можно разместить один из двух нижеопубликованных кодов в модуле нужного рабочего листа [FAQ31], не забывая указать ячейки,,которые необходимо синхронизировать и, разумеется, сохранить изменения.
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        Application.EnableEvents = False
        Select Case Target(1).Address
            Case "$A$1": [C10] = [A1] '[C10] = Target(1)
            Case "$C$10": [A1] = [C10] '[A1] = Target(1)
        End Select
        Application.EnableEvents = True
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        Dim iSource As Range
        Set iSource = Intersect([A1,B1,C10], Target)
        If iSource Is Nothing Then Exit Sub
        
        Application.EnableEvents = False
        [A1,B1,C10] = iSource.Value
        Application.EnableEvents = True
    End Sub
    Комментарий : Обратите внимание на второй вариант, т.к. его проще адаптировать для трёх(и более ячеек). Кроме того, он не блокирует выполнение событий при каждом изменении в любой из ячеек рабочего листа.
  • Ответ :

    Если Вы привыкли вводить дату с использованием малой клавиатуры и хотите, вместо стандартных разделителей дня/месяца/года слэша, точки или тире, использовать запятую , т.е. 10,06,2018 ; 10,6,18 или просто 10,6 (если речь идёт о вводе даты текущего года), то разместите нижеопубликованный код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        If Target.Count > 1 Then Exit Sub
        
        iText$ = Replace(CStr(Target.Value2), ",", "/")
        If Not IsDate(iText$) Then Exit Sub
        
        Application.EnableEvents = False
        Target.NumberFormat = "dd/mm/yyyy"
        Target = CDate(iText$)
        Application.EnableEvents = True
    End Sub
    Примечание :
  • Если подобное преобразование должно происходить только в ячейках определённого диапазона, то смотрите следующий совет [FAQ99]
  • Если же преобразование необходимо производить во всех рабочих листах нужной рабочей книги, то используйте событие рабочей книги [FAQ172]
  • Ответ :

    Если Вы привыкли вводить время с использованием малой клавиатуры и хотите, вместо стандартнго разделителя часов:минут:секунд - двоеточия использовать запятую , т.е. 12,35 или 12,1,38 (если речь идёт также и о вводе секунд), то можно воспользоваться стандартной автозаменой. A чтобы эта замена не происходила во всех ячейках, макрос будет удалять автозамену, если пользователь выделил ненужные ячейки. Для этого, разместите нижеопубликованный код в модуле нужного рабочего листа [FAQ31] и укажите свой диапазон с временем. В примере это весь столбец A:A, но Вы можете указать другой, в т.ч. и несмежный, например, [A:A,F:F] или [A10:A102,C5,F5]
  • Private delAUItem As Boolean
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
        If Not Intersect(Target, [A:A]) Is Nothing Then
           'If delAUItem = True Then Exit Sub
           Application.AutoCorrect.AddReplacement ",", ":"
           delAUItem = True
        Else
           If delAUItem = True Then
              Application.AutoCorrect.DeleteReplacement ","
              delAUItem = False 'delAUItem = Not delAUItem
           End If
        End If
    End Sub
    Примечание : Маловероятно, но если Вы уже используете автозамену запятой на другой символ(ы), то вместо удаления, просто верните всё на круги своя. Т.е. замените Application.AutoCorrect.DeleteReplacement "," на (где ; это символ, на который необходимо заменить , ) Application.AutoCorrect.AddReplacement ",", ";"
  • Ответ :

    Если Вы не можете вводить дату с использованием стандартных разделителей дня/месяца/года слэша, точки или тире, и хотите вообще отказаться от их применения, т.е. для вводить 100618 или 50618 (только для дней от 1 до 9), то просто разместите нижеопубликованный код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        If Target.Count > 1 Then Exit Sub
    
        iText$ = CStr(Target.Value2)
        If iText$ Like "#####*" Then
           iText$ = Format(iText$, "00\.00\.00")
           If IsDate(iText$) = True Then
              Application.EnableEvents = False
              Target.NumberFormat = "dd/mm/yy"
              Target = CDate(iText$)
              Application.EnableEvents = True
           End If
        End If
    End Sub
    Примечание :
  • Если подобное преобразование должно происходить только в ячейках определённого диапазона, то смотрите следующий совет [FAQ99]
  • Если же преобразование необходимо производить во всех рабочих листах нужной рабочей книги, то используйте событие рабочей книги [FAQ172]
  • Ответ :

    Для того, чтобы выбрать случайную ячейку, из указанного диапазона, в примере это [A1:C3], достаточно об'единить два уже опубликованных совета :
  • Randomize 'Timer
    
    With Range("A1:C3")
         MsgBox .Cells(Int((Rnd * .Count) + 1))
    End With
    Randomize 'Timer
    
    With Range("A1:C3")
         MsgBox .Cells(Int((Rnd * .Count) + 1))
    End With
    Разумеется, VB(A) функция MsgBox используется только в качестве демонстрации, но если Вы не знаете как адаптировать этот пример для работы с об'ектными переменными, то :
    Dim iSource As Range, iCell As Range
    Set iSource = Range("A1:C3")
    
    Randomize 'Timer
    
    Set iCell = iSource(Int((Rnd * iSource.Count) + 1))
    

  • Ответ :

    Если Вам необходимо сохранить данные ячеек, содержащих текст, в текстовый файл. Причём, текст тех ячеек, где использовался ALT+ENTER необходимо также "разбить" по строкам, то воспользуйтесь любым из нижеопубликованных макросов :
  • Private Sub SaveVerticalText1() 'XL2000
        Dim iFileName$, iCell As Range
        iFileName = Replace(ActiveWorkbook.FullName, ".xls", ".txt")
        
        Open iFileName For Output As #1
             For Each iCell In ActiveSheet.UsedRange. _
                 SpecialCells(xlConstants, xlTextValues)
                 Print #1, Replace(iCell, vbLf, vbCrLf)
             Next
        Close #1
    
        ActiveWorkbook.FollowHyperlink iFileName 'Для наглядности
    End Sub
    Private Sub SaveVerticalText2() 'XL2000
        Dim iFileName$, iCell As Range, tmp As Variant
        iFileName = Replace(ActiveWorkbook.FullName, ".xls", ".txt")
    
        Open iFileName For Output As #1
             For Each iCell In ActiveSheet.UsedRange. _
                 SpecialCells(xlConstants, xlTextValues)
                 For Each tmp In Split(iCell.Value, vbLf)
                     Print #1, tmp
                 Next
             Next
        Close #1
    
        ActiveWorkbook.FollowHyperlink iFileName 'Для наглядности
    End Sub

  • Ответ :

    Если Вам необходимо убрать пустые ячейки из диапазона ячеек, причём это необходимо проделать без удаления пустых ячеек/строк, то ниже опубликовано несколько вариантов, как это можно осуществить.

    Вариант I. 'Сортировка
  • Private Sub ListNotEmptyCell()
        Dim iSource As Range
        Set iSource = Range("A1", Cells(Rows.Count, "A").End(xlUp))
        
        iSource.Sort Key1:=iSource(1), Order1:=xlAscending, Header:=xlGuess
    End Sub
    Впрочем, мы вполне можем обойтись и без определения последней заполненной ячейки, а указать сразу весь диапазон целиком.
    Private Sub ListNotEmptyCell1()
        Range("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
    End Sub
    Примечание : К плюсам этого способа можно отнести скорость выполнения операции и перемещение примечаний(комментариев), вместе с текстом. A к минусам, изменения первоначального порядка ячеек. И если этот недостаток является для Вас фатальным, то :

    Вариант II.
    Private Sub ListNotEmptyCell2()
        Dim iSource As Range, iArr, iRow1&, iRow2&
        Set iSource = Range("A1", Cells(Rows.Count, "A").End(xlUp))
    
        iArr = iSource.Value
        For iRow1 = 1 To UBound(iArr)
            If Not IsEmpty(iArr(iRow1, 1)) Then
               iRow2 = iRow2 + 1
               iArr(iRow2, 1) = iArr(iRow1, 1)
            End If
        Next
    
        iSource.ClearContents: iSource(1).Resize(iRow2) = iArr
    End Sub
    Private Sub ListNotEmptyCell3()
        Dim iArr1, iArr2, iRow1&, iRow2&
        iArr1 = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    
        ReDim iArr2(1 To UBound(iArr1), 0) 'Or 1 To 1
        For iRow1 = 1 To UBound(iArr1)
            If Not IsEmpty(iArr1(iRow1, 1)) Then
               iRow2 = iRow2 + 1
               iArr2(iRow2, 0) = iArr1(iRow1, 1)
            End If
        Next
        
        Range("A1").Resize(iRow1 - 1) = iArr2 'Range("B1").Resize(iRow2) = iArr2
    End Sub
    Совет : Если тип данных, хранящихся в ячейках заранее известен, например, это только текст и ничего другого, то можно с'экономить ресурсы, и явно указать этот тип, например, в случае с текстом, это String, т.е. iArr2$() или iArr2() As String
    Private Sub ListNotEmptyCell4()
        Dim iArr, tmp, iRow1&, iRow2&
        iArr = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    
        For iRow1 = 1 To UBound(iArr)
            tmp = iArr(iRow1, 1)
            iArr(iRow1, 1) = Empty
            If Not IsEmpty(tmp) Then
               iRow2 = iRow2 + 1
               iArr(iRow2, 1) = tmp
            End If
        Next
    
        Range("A1").Resize(iRow1 - 1) = iArr
    End Sub
    Примечание : У этого варианта есть способы избавиться от лишних действий, например, "очищать" элементы массива, после проверки и при условии If iRow1 > iRow2 Then iArr(iRow1, 1) = Empty или вообще использовать для очистки второй цикл For iRow2 = iRow2 + 1 To iRow1 - 1
  • Ответ :

    Если Вам необходимо, чтобы макрос удалил ненужные столбцы, т.е. столбцы, первая строка которых содержит определённый текст, то :

    Вариант I.
  • Private Sub DeleteNotUsedColumns()
        Dim iCell As Range, iColumn As Variant
        For Each iColumn In Array("State", "Customer name", "Gallons", "Supplier", "Carrier")
            Set iCell = ActiveSheet.UsedRange.Rows(1).Find(iColumn, , xlValues, xlWhole)
            If Not iCell Is Nothing Then iCell.EntireColumn.Delete
        Next
    End Sub
    Если же столбцов с указанным текстом в заголовке(шапке) может быть несколько, что маловероятно, но всё таки, то имеет смысл использовать :
    Private Sub DeleteNotUsedColumns()
        Dim iCell As Range, iColumn As Variant
        For Each iColumn In Array("State", "Customer name", "Gallons", "Supplier", "Carrier")
            Set iCell = ActiveSheet.UsedRange.Rows(1).Find(iColumn, , xlValues, xlWhole)
            Do Until iCell Is Nothing
               iCell.EntireColumn.Delete
               Set iCell = ActiveSheet.UsedRange.Rows(1).FindNext
            Loop
        Next
    End Sub
    Примечание : И, разумеется, если лист/книга перегружена формулами, то на время удаления ненужных столбцов имеет смысл установить ручной пересчёт формул и не помешает отключить обновление экрана
    Private Sub DeleteNotUsedColumns() 'full version
        Application.ScreenUpdating = False
        Application.Calculation = xlManual
        
        Dim iSource As Range, iCell As Range, iColumn As Variant
        Set iSource = ActiveSheet.UsedRange.Rows(1)
        For Each iColumn In Array("State", "Customer name", "Gallons", "Supplier", "Carrier")
            Set iCell = iSource.Find(iColumn, , xlValues, xlWhole)
            If Not iCell Is Nothing Then iCell.EntireColumn.Delete
        Next
        
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = True
    End Sub
    Вариант II.
    Private Sub DeleteNotUsedColumns2()
        Dim iArr As Variant, iColumn&, iRow&
        iArr = Array("State", "Customer name", "Gallons", "Supplier", "Carrier")
        iRow = ActiveSheet.UsedRange.Row
        For iColumn = Cells(iRow, Columns.Count).End(xlToLeft).Column To 1 Step -1
            If IsNumeric(Application.Match(Cells(iRow, iColumn), iArr, 0)) Then Columns(iColumn).Delete
        Next
    End Sub
    Private Sub DeleteNotUsedColumns2v2()
        Dim iSource As Range, iArr As Variant, iCount&
        Set iSource = ActiveSheet.UsedRange.Rows(1)
        iArr = Array("State", "Customer name", "Gallons", "Supplier", "Carrier")
        iArr = Application.Match(iSource, iArr, 0)
        For iCount = UBound(iArr) To 1 Step -1
            If IsNumeric(iArr(iCount)) = True Then
               iSource.EntireColumn(iCount).Delete
            End If
        Next
    End Sub
    Второй подвариант предназначен для таблиц, содержащих более одного заполненного столбца. Если же Вы попытаетесь применить его к пустому листу или листу, где наличествует таблица с одним единственным столбцом, то получите ошибку.

    Примечание : Тоже самое, что и в первом варианте.


    Бонус : Если же Вы не хотите перечислять ненужные столбцы в макросе, а желаете выбрать их в нестандартном диалоговом окне UserForm, то расположите на форме следующие элементы управления :

    1) Поле со списком ListBox1
    2) Кнопку CommandButton1

    И скопируйте в модуль формы нижеопубликованный код. Теперь, после того, как Вы отобразите форму и выберите ненужные столбцы, просто кликните кнопку.

    Private Sub UserForm_Initialize()
        ListBox1.Column = ActiveSheet.UsedRange.Rows(1).Value
        ListBox1.ListStyle = fmListStyleOption
        ListBox1.MultiSelect = fmMultiSelectMulti
    End Sub
    
    Private Sub CommandButton1_Click()
        Dim iCount&
        For iCount = ListBox1.ListCount To 1 Step -1
            If ListBox1.Selected(iCount - 1) = True Then
               ActiveSheet.UsedRange.Columns(iCount).Delete
            End If
        Next
        Unload Me
    End Sub
    
    'Private Sub CommandButton1_Click()
    '    Dim iSource As Range, iCount&
    '    Set iSource = ActiveSheet.UsedRange.Columns
    '    For iCount = ListBox1.ListCount To 1 Step -1
    '        If ListBox1.Selected(iCount - 1) Then iSource(iCount).Delete
    '    Next
    '    Unload Me
    'End Sub

  • Ответ :

    Если Вам необходимо, чтобы макрос удалил ненужный пробел(ы) в начале и конце текста, то используйте любой из нижеопубликованных вариантов. Только учтите, что в указанном диапазоне не должно быть ячеек с числами, датами и значениями ошибок. Т.к. в последнем случае мы получим ошибку, а в остальных текстовое представление этих данных, ибо VB(A) функция Trim возвращает именно строку(текст) Проще говоря, вместо числа 12,78 получим текст "12,78"
  • MsgBox TypeName(12.78)
    MsgBox TypeName(Trim(12.78))
    Правда обладатели старых версий Excel (вплоть до 2003 включительно) могут использовать второй вариант и, в некоторых случаях, избежать такого преобразования, но, повторюсь, в новых версиях Excel (начиная с 2007) халява закончилась и нужно самим анализировать данные ячеек = элементов массива.

    Вариант I.
    Private Sub DeleteSpace(iSource As Range)
        Application.ScreenUpdating = False
        Dim iCell As Range
        For Each iCell In iSource
            iCell = Trim$(iCell)
        Next
        Application.ScreenUpdating = True
    End Sub
    
    Private Sub Test()
        DeleteSpace [A1,C1,F1:F100]
    End Sub
    Примечание : И, разумеется, если лист/книга перегружена формулами, то на время удаления ненужных пробелов имеет смысл установить ручной пересчёт формул.

    Вариант II.
    Private Sub DeleteSpace(iSource As Range)
        Dim iArr, iRow&, iColumn&
        iArr = iSource.Value
        For iRow = 1 To UBound(iArr)
            For iColumn = 1 To UBound(iArr, 2)
                iArr(iRow, iColumn) = Trim$(iArr(iRow, iColumn))
            Next
        Next
        iSource.Value = iArr
    End Sub
    
    Private Sub Test()
        DeleteSpace Range("A1:A100")
    End Sub
    Примечание : Второй вариант предназначен строго для обработки диапазона смежных ячеек.
    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2019 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff