Excel vba скопировать только видимые ячейки
Пожалуйста, посмотрите мой код ниже:
Примечание: если вы используете, With ActiveSheet то это совершенно бесполезно, пока вы не начнете что-то с . подобным, .Range("A1:A" & lastRow).Value2 = иначе With оператор не вступит в силу.
Что-то вроде .Value2 = .Value не работает со специальными ячейками типа visible, потому что…
… Например, если lastRow = 50 и есть, hiddenRows = 10 то…
- у вашего источника Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible)
есть lastRow - hiddenRows = 40 строки - но в вашем пункте назначения Range("A1:A" & lastRow).Value2
есть lastRow = 50 строки.
На первом вы вычтите видимые строки, чтобы они стали разными по размеру. Следовательно, .Value2 = .Value это не работает, потому что вы не можете заполнить 50 строк только 40 исходными строками.
Но что вы можете сделать, так это Copy и SpecialPaste
Тем не менее, я рекомендую избегать ActiveSheet или, ActiveWorkbook если это возможно, и ссылаться на рабочую книгу, например, на ThisWorkbook . Мое предложение:
@DisplayName правильно, даже если у меня есть ленивые моменты, но я добавил улучшенную версию для практики. Спасибо, что указали.
Чтобы определить, является ли ячейка видимой или нет, должны быть видны и ее столбец, и строка. Это означает, что .Hidden свойство столбца и строки должно быть установлено на False .
Вот пример кода того, как копировать только видимые диапазоны между двумя листами.
Представьте, что у вас есть такой ввод в Рабочих листах (1):
Затем вы вручную скрываете столбец B и хотите попасть в Worksheets(2) каждую ячейку из Range(A1:C4) , без тех, что в столбце B . Нравится:
Для этого вы должны проверить каждую ячейку в диапазоне, видимы ли ее столбец или строка. Возможное решение:
Просто общий совет - всякий раз, когда вы используете что-то подобное, Range("A1").Value2 = Range("A1").Value2 убедитесь, что оба они одинаковы, а не левое Value2 и правое .Value . Вероятно, это не принесет того, чего вы ожидаете.
Сама команда представляет собой выпадающее меню:
Команда Копировать является командой по умолчанию и копирует выделенные на активном листе ячейки. Т.е. по нажатии на значок без раскрытия меню будут скопированы выделенные на активном листе ячейки.
При нажатии на стрелочку справа от команды Копировать раскрывается меню, которое предоставляет доступ к командам:
- Вставить все
Будут вставлены ячейки полностью - с форматами, формулами, примечаниями и т.п. - Вставить значения
Будут вставлены только значения скопированных ячеек. Формулы, форматы, примечания и т.п. перенесены не будут. - Вставить значения и форматы
Будут вставлены только значения и форматы скопированных ячеек. Формулы и примечания перенесены не будут. Может пригодиться если форматы ячеек сохранить надо, а формулы нет. - Вставить формулы
Будут вставлены только формулы скопированных ячеек. Если в какой-то из ячеек нет формулы - будет скопировано значение ячейки. Форматы, примечания и т.п. перенесены не будут. После вызова команды появится окно:
Вставка данных всегда производится начиная с активной ячейки. Вставка данной командой может быть произведена только если ранее ячейки были скопированы командой Копировать надстройки MulTEx.
Наиболее быстрые методы вставки - это вставка Вставить значения или Вставить формулы. В этом режиме вставка происходит примерно в 4-5 раз быстрее, чем Вставить все или Вставить значения и форматы.
Во время вставки в статус баре Excel(в нижней левой части окна Excel) отображается информация о текущем процессе вставки, чтобы можно было определить насколько быстро движется процесс и сколько примерно еще осталось:
Для чего это может быть нужно: если данные с одного листа необходимо перенести на другой лист, а данные на листах отфильтрованы - штатными средствами Excel простыми действиями копирования/вставки сделать этого не получится.
Видеоинструкции по использованию надстройки MulTEx
Поделитесь своим мнением
Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
Добрый день всем!
Помогите пожалуйста разобрать код ниже!
Есть код ниже, который копирует позволяет копировать уникальные строки из выбранного юзером в ИНПУТБОКСе диапазона.
Беда в том, что если в выбранном юзером диапазоне есть свернутые и скрытые ячейки (см вложенный файл), то эти ячейки тоже копируются.
Вопросы:
1. Как сделать так, чтобы копировались только видимые ячеки из выбранного юзером диапазона?
Я пытался заменить строку 10 вот таким выражением, чтобы получать только видимые ячейки:
[vba]
2. В строке 20 в переменную avVals пишутся все значения из диапазона rVals , а потом в строке 30 появляется какая-то БЕЗЫМЯННАЯ коллекция .
Как такое получилось ? Как можно добавить какую-то Коллекцию без имени прямо в середине кода без объявления этой Коллекции в начале кода выражением типа [vba]
Sub Extract_Unique()
Dim x, avArr, li As Long
Dim avVals
Dim rVals As Range, rResultCell As Range
On Error Resume Next
'запрашиваем адрес ячеек для выбора уникальных значений
Set rVals = Application.InputBox("Укажите диапазон ячеек для выборки уникальных значений", "Запрос данных", "A2:A10", Type:=8)
If rVals Is Nothing Then
MsgBox "Недостаточно данных для выбора значений", vbInformation, "www.excel-vba.ru"
Exit Sub
End If
20 avVals = rVals.Value
'запрашиваем ячейку для вывода результата
Set rResultCell = Application.InputBox("Укажите ячейку для вставки отобранных уникальных значений", "Запрос данных", "E2", Type:=8)
If rResultCell Is Nothing Then 'если нажата кнопка Отмена
Exit Sub
End If
'определяем максимально возможную размерность массива для результата
ReDim avArr(1 To rVals.Rows.Count, 1 To 1)
'при помощи объекта Коллекции(Collection)
'отбираем только уникальные записи,
'т.к. Коллекции не могут содержать повторяющиеся значения
30 With New Collection
On Error Resume Next
For Each x In avVals
If Len(CStr(x)) Then 'пропускаем пустые ячейки
.Add x, CStr(x) 'если добавляемый элемент уже есть в Коллекции - возникнет ошибка
'если же ошибки нет - такое значение еще не внесено,
'добавляем в результирующий массив
If Err = 0 Then
li = li + 1
avArr(li, 1) = x
Else
'обязательно очищаем объект Ошибки
Err.Clear
End If
End If
Next
End With
'записываем результат на лист, начиная с указанной ячейки
If li Then rResultCell.Cells(1, 1).Resize(li).Value = avArr
End Sub
Кто знает , помогите пожалуйста.
Спасибо
Добрый день всем!
Помогите пожалуйста разобрать код ниже!
Есть код ниже, который копирует позволяет копировать уникальные строки из выбранного юзером в ИНПУТБОКСе диапазона.
Беда в том, что если в выбранном юзером диапазоне есть свернутые и скрытые ячейки (см вложенный файл), то эти ячейки тоже копируются.
Вопросы:
1. Как сделать так, чтобы копировались только видимые ячеки из выбранного юзером диапазона?
Я пытался заменить строку 10 вот таким выражением, чтобы получать только видимые ячейки:
[vba]
2. В строке 20 в переменную avVals пишутся все значения из диапазона rVals , а потом в строке 30 появляется какая-то БЕЗЫМЯННАЯ коллекция .
Как такое получилось ? Как можно добавить какую-то Коллекцию без имени прямо в середине кода без объявления этой Коллекции в начале кода выражением типа [vba]
Sub Extract_Unique()
Dim x, avArr, li As Long
Dim avVals
Dim rVals As Range, rResultCell As Range
On Error Resume Next
'запрашиваем адрес ячеек для выбора уникальных значений
Set rVals = Application.InputBox("Укажите диапазон ячеек для выборки уникальных значений", "Запрос данных", "A2:A10", Type:=8)
If rVals Is Nothing Then
MsgBox "Недостаточно данных для выбора значений", vbInformation, "www.excel-vba.ru"
Exit Sub
End If
20 avVals = rVals.Value
'запрашиваем ячейку для вывода результата
Set rResultCell = Application.InputBox("Укажите ячейку для вставки отобранных уникальных значений", "Запрос данных", "E2", Type:=8)
If rResultCell Is Nothing Then 'если нажата кнопка Отмена
Exit Sub
End If
'определяем максимально возможную размерность массива для результата
ReDim avArr(1 To rVals.Rows.Count, 1 To 1)
'при помощи объекта Коллекции(Collection)
'отбираем только уникальные записи,
'т.к. Коллекции не могут содержать повторяющиеся значения
30 With New Collection
On Error Resume Next
For Each x In avVals
If Len(CStr(x)) Then 'пропускаем пустые ячейки
.Add x, CStr(x) 'если добавляемый элемент уже есть в Коллекции - возникнет ошибка
'если же ошибки нет - такое значение еще не внесено,
'добавляем в результирующий массив
If Err = 0 Then
li = li + 1
avArr(li, 1) = x
Else
'обязательно очищаем объект Ошибки
Err.Clear
End If
End If
Next
End With
'записываем результат на лист, начиная с указанной ячейки
If li Then rResultCell.Cells(1, 1).Resize(li).Value = avArr
End Sub
Кто знает , помогите пожалуйста.
Спасибо
Помогите пожалуйста разобрать код ниже!
Есть код ниже, который копирует позволяет копировать уникальные строки из выбранного юзером в ИНПУТБОКСе диапазона.
Беда в том, что если в выбранном юзером диапазоне есть свернутые и скрытые ячейки (см вложенный файл), то эти ячейки тоже копируются.
Вопросы:
1. Как сделать так, чтобы копировались только видимые ячеки из выбранного юзером диапазона?
Я пытался заменить строку 10 вот таким выражением, чтобы получать только видимые ячейки:
[vba]
2. В строке 20 в переменную avVals пишутся все значения из диапазона rVals , а потом в строке 30 появляется какая-то БЕЗЫМЯННАЯ коллекция .
Как такое получилось ? Как можно добавить какую-то Коллекцию без имени прямо в середине кода без объявления этой Коллекции в начале кода выражением типа [vba]
Sub Extract_Unique()
Dim x, avArr, li As Long
Dim avVals
Dim rVals As Range, rResultCell As Range
On Error Resume Next
'запрашиваем адрес ячеек для выбора уникальных значений
Set rVals = Application.InputBox("Укажите диапазон ячеек для выборки уникальных значений", "Запрос данных", "A2:A10", Type:=8)
If rVals Is Nothing Then
MsgBox "Недостаточно данных для выбора значений", vbInformation, "www.excel-vba.ru"
Exit Sub
End If
20 avVals = rVals.Value
'запрашиваем ячейку для вывода результата
Set rResultCell = Application.InputBox("Укажите ячейку для вставки отобранных уникальных значений", "Запрос данных", "E2", Type:=8)
If rResultCell Is Nothing Then 'если нажата кнопка Отмена
Exit Sub
End If
'определяем максимально возможную размерность массива для результата
ReDim avArr(1 To rVals.Rows.Count, 1 To 1)
'при помощи объекта Коллекции(Collection)
'отбираем только уникальные записи,
'т.к. Коллекции не могут содержать повторяющиеся значения
30 With New Collection
On Error Resume Next
For Each x In avVals
If Len(CStr(x)) Then 'пропускаем пустые ячейки
.Add x, CStr(x) 'если добавляемый элемент уже есть в Коллекции - возникнет ошибка
'если же ошибки нет - такое значение еще не внесено,
'добавляем в результирующий массив
If Err = 0 Then
li = li + 1
avArr(li, 1) = x
Else
'обязательно очищаем объект Ошибки
Err.Clear
End If
End If
Next
End With
'записываем результат на лист, начиная с указанной ячейки
If li Then rResultCell.Cells(1, 1).Resize(li).Value = avArr
End Sub
Кто знает , помогите пожалуйста.
Спасибо
Автор - t330
Дата добавления - 29.01.2020 в 13:18
Я пытаюсь создать динамический макрос, который можно использовать во многих различных книгах для достижения следующих целей: я хотел бы, чтобы пользователь вводил диапазон, который они хотели бы скопировать. Этот диапазон будет отфильтрован. Затем я хотел бы, чтобы пользователь выбирал диапазон для вставки скопированных данных. Диапазон, в который они будут вставляться, также фильтруется (фильтры могут отличаться от фильтров, из которых были скопированы данные. ИДЕАЛЬНО пользователь выберет только верхнюю левую ячейку диапазона для вставки (вместо того, чтобы выбирать все).
Приведенный ниже код скопирует отфильтрованные данные (только видимые ячейки), как я хотел.
Вставка - это, конечно, сложная часть. Я обнаружил, что могу успешно "вставить" вручную следующим образом:
Предположим, что скопированный диапазон - A1: A10, а диапазон вставки - B10: B20.
Я могу ввести формулу «= A1» в ячейку B10 ---> скопировать ячейку B10 ----> выбрать нужный диапазон для вставки в ----> использовать «Alt;» ярлык ----> вставить.
Следующий код пытается автоматизировать эту логику в VBA:
Это создает две проблемы:
Он правильно вставляется только в видимые ячейки, но в настоящее время вводит «= CopyRange» в качестве текста в диапазон, в который я хочу вставить (вместо формулы, устанавливающей «вставить ячейку» равной «копируемой ячейке».
Этот код еще не позволяет пользователю выбирать точный диапазон. Это позволяет им выбрать начальную точку, но затем копирует и вставляет в конец вставляемого столбца. Мне нужно, чтобы пользователь мог выбрать диапазон и еще не нашел способ сделать это без возникновения ошибок.
Поискав в сети, я нашел другие варианты «вставки макросов в видимые ячейки». Я попытался объединить их с первым фрагментом кода, которым поделился в этом посте. Эта комбинация показана ниже.
Это выполняется без ошибок, но макрос вставляется только до тех пор, пока не попадет в скрытую строку. Таким образом, если строки 1, 2, 3 и 6 видны, но 4 и 5 скрыты, макрос будет вставлен в 1, 2 и 3, но не на 4,5 или 6.
Я предпринял несколько других попыток, но пока они кажутся наиболее многообещающими. Мы очень ценим любые предложения / помощь, которые может предложить каждый. Самый важный ключ - сделать это полностью динамичным и максимально интуитивно понятным для пользователя.
Я пытаюсь скопировать отфильтрованные данные с одного листа на другой, но по какой-то причине я получаю ошибку времени выполнения 1004, в которой говорится «чтобы скопировать все ячейки с другого листа на этот лист, убедитесь, что вы вставили их в первую ячейку (A1 или R1C1)» Я на самом деле не хочу, чтобы строка заголовка была скопирована, поэтому все видимые строки этой строки
Я хочу, чтобы скопированные данные были вставлены в первую доступную строку на целевом листе. Вот код, который у меня есть, который фильтрует определенные вещи, но затем падает на строку вставки
Любые предложения относительно того, что не хватает, чтобы он работал правильно?
Хорошо, возможно, я должен был попытаться ответить на этот вопрос по-другому, опубликовав исходный рабочий макрос, который мне предоставили, а не опубликовать мою попытку переписать его.
Это в основном то же самое, что я написал выше, с формулой, измененной для поиска другого текста, хотя она также имеет настройки автофильтра (что мне не нужно) и скрывает столбцы (что мне не нужно делать). Это прекрасно работает для меня и делает именно то, что должен. Я в основном пытался продублировать его и удалить ненужные элементы, но, как вы увидели, обнаружил изначально указанную ошибку. Очевидно, мои ограниченные знания вызвали первоначальную проблему.
Как указано, это работает абсолютно идеально, вложенные С и все. Я могу изменить исходную формулу, чтобы она смотрела в правильном столбце и только для текста, который я хочу, но я, очевидно, не смог успешно удалить элементы автофильтра и элементы, которые скрывают столбцы, не вызывая ошибки. Я предполагаю, что удаление строки .Parent.AutoFilter.Range.Offset(1).Copy было виновником, но я не был уверен, как подойти к удалению нежелательных элементов.
Этот исходный макрос был предоставлен мне на одном из форумов, и я не хочу изменять часть формулы, которая хорошо справляется с поиском множества текстовых элементов, которые необходимо скопировать. Вот почему я хотел изменить только раздел автофильтра и раздел скрытых столбцов.
Я не уверен, помогает ли это вообще, но это может немного прояснить ситуацию
Читайте также: