копия ячейки, если она содержит текст

Question

Данные передаются из веб-формы в Excel. Не каждая ячейка получает входные данные. Существует много ячеек, отнимающих много времени для сканирования каждой ячейки, ищущей текст.

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

Я нашел этот макрос:.

Sub CopyC() 
Dim SrchRng As Range, cel As Range 
Set SrchRng = Range("C1:C10") 
For Each cel In SrchRng 
    If cel.Value <> "" Then 
     cel.Offset(2, 1).Value = cel.Value 
    End If 
Next cel 

Он захватывает только клетки, содержащие текст, но он отображает его в том же макете, что он нашел его в Любая помощь будет оценена и сэкономить мне много отсканировать время в будущем, заранее спасибо :)

Answer 1

Я думаю, это то, что вы ищете:

Sub CopyNonBlankCells() 
    Dim cel As Range, myRange As Range, CopyRange As Range 

    Set myRange = Sheet1.Range("C1:C20") '---> give your range here 

    For Each cel In myRange 
     If Not IsEmpty(cel) Then 
      If CopyRange Is Nothing Then 
       Set CopyRange = cel 
      Else 
       Set CopyRange = Union(CopyRange, cel) 
      End If 
     End If 
    Next cel 

    CopyRange.Copy Sheet2.Range("C1") '---> enter desired range to paste copied range without blank cells 
End Sub 

Приведенный выше код будет копировать диапазон C1:C20 в Sheet1 до C1 в Sheet2

Получено от here.

EDIT: После ответа основан на ваш комментарий ________________________________________________________________________________

Если вы будете писать что-то вроде ниже

Set myRange = Sheet1.Range("G:G") 
Set myRange = Sheet2.Range("G:G") 

myRange будет первый сет Sheet1.Range("G:G"), а затем Sheet2.Range("G:G"), что означает текущий диапазон, который myRange будет Sheet2.Range("G:G").

Если вы хотите использовать несколько диапазонов, вы можете использовать функцию UNION, но есть ограничение, использующее UNION, вы можете комбинировать разные диапазоны, но только с одним листом. И ваше требование - объединить диапазоны с разных листов. Для этого я добавляю новый рабочий лист и добавляю диапазон G:G от всех листов к нему. Затем после использования вновь добавленного листа я удаляю его.

Следующий код даст вам желаемый результат в листе с именем Result.

Sub CopyNonBlankCells() 
    Dim cel As Range, myRange As Range, CopyRange As Range 

    Dim wsCount As Integer, i As Integer 
    Dim lastRow As Long, lastRowTemp As Long 
    Dim tempSheet As Worksheet 

    wsCount = Worksheets.Count '--->wsCount will give the number of Sheets in your workbook 

    Set tempSheet = Worksheets.Add '--->new sheet added 
    tempSheet.Move After:=Worksheets(wsCount + 1) 

    For i = 1 To wsCount 
     If Sheets(i).Name <> "Result" Then '---> not considering sheet "Result" for taking data 
      lastRow = Sheets(i).Cells(Rows.Count, "G").End(xlUp).Row '--->will give last row in sheet 
      lastRowTemp = tempSheet.Cells(Rows.Count, "G").End(xlUp).Row '--->will give last row in newly added sheet 
      Sheets(i).Range("G1:G" & lastRow).Copy _ 
      tempSheet.Range("G" & lastRowTemp + 1).End(xlUp)(2) 
     End If 
    Next i 

    lastRowTemp = tempSheet.Cells(Rows.Count, "G").End(xlUp).Row 
    Set myRange = tempSheet.Range("G1:G" & lastRowTemp) '--->setting range for removing blanks cells 

    For Each cel In myRange 
     If Not IsEmpty(cel) Then 
      If CopyRange Is Nothing Then 
       Set CopyRange = cel 
      Else 
       Set CopyRange = Union(CopyRange, cel) 
      End If 
     End If 
    Next cel 

    CopyRange.Copy Sheets("Result").Range("G1") '---> enter desired range to paste copied range without blank cells 

    Application.DisplayAlerts = False 
    tempSheet.Delete  '--->deleting added sheet 
    Application.DisplayAlerts = True 
End Sub 

Answer 2

Вы можете использовать массивы!

Вместо копирования информации из одной ячейки в другую вы можете сначала сохранить всю информацию в массиве, а затем распечатать массив на другом листе. Вы можете указать массиву, чтобы избежать пустых ячеек. Как правило, использование массивов - лучший способ хранения информации. (Часто самый быстрый способ работы с информацией)

Если вы смотрите только на один столбец, вы можете использовать одномерный массив. Если вы просматриваете несколько столбцов и хотите распечатать информацию в соответствующем столбце (но разных ячейках) на другой странице, вы можете использовать многомерный массив для хранения номера столбца/всего остального, что вам нужно.

От вашего кода, это может выглядеть следующим образом:

Sub CopyC() 
Dim SrchRng As Range, cel As Range 

'Declare your 1-d array (I don't know what you are storing) 
Dim myarray() as variant 
Dim n as integer 
Dim i as integer 

Set SrchRng = Range("C1:C10") 
'define the number of elements in the array - 1 for now, increase it as we go 
n = 0 
Redim myarray(0 to n) 

For Each cel In SrchRng 
    If cel.Value <> "" Then 
     'redim preserve stores the previous values in the array as you redimension it 
     Redim Preserve myarray(0 to n) 
     myarray(n) = cel.Value 
     'increase n by 1 so next time the array will be 1 larger 
     n = n + 1 
    End If 
Next cel 

'information is now stored, print it out in a loop 
'this will print it out in sheet 2 providing it is called "Sheet2" 
For i = 0 to ubound(myarray) 
    Sheets("Sheet2").cells(i,1).value = myarray(i) 
Next i