Копировать строку, если диапазон ячеек не пуст

Question

Интересно, сможет ли кто-нибудь мне помочь, пожалуйста.

У меня есть электронная таблица Excel (2003) под названием «Ввод» с данными в столбцах от B до N. Что я хотел бы сделать, так это то, что если в какой-либо из ячеек столбца B есть текст, я бы хотел скопируйте строку, но только столбцы «B», «I» и «N», и вставьте их во вторую электронную таблицу под названием «Выход» в ячейке № B2.

Если это вообще возможно, после вставки информации я хотел бы добавить слово «Запланированный сайт» в столбец «E» на листе «Вывод», если в ячейках столбца «B» есть текст. ,

Я делал это вручную, и это занимает довольно много времени.

Мне просто интересно, сможет ли кто-нибудь показать мне, пожалуйста, как я могу автоматизировать это.

Большое спасибо

Answer 1

Я хотел сделать то же самое в электронной таблице Google Docs, чтобы макросы отсутствовали, мне удалось сделать это с некоторыми IF и VLOOKUP. Это кажется немного запутанным, возможно, у кого-то есть более эффективный способ сделать это, но это должно работать без макросов:

Слева от ввода я создал столбец, начинающийся с 0 и увеличивающийся каждый раз, когда столбец B содержит данные:

A1=0
A2=IF(ISBLANK(B2),A1,A1+1)
A3=IF(ISBLANK(B3),A2,A2+1)
...

поэтому первый лист выглядит так:

0    
1    data1
1
2    data2
3    data3
3    
3
4    data4

Затем на выходном листе укажите столбец с просто увеличивающимися значениями и выполните vlookup для первой строки, содержащей это число:

A1=1
A2=2
...

и

B1=VLOOKUP(A1,Sheet1!A:B,2,FALSE)
B2=VLOOKUP(A2,Sheet1!A:B,2,FALSE)
...

Итак, второй лист выглядит так:

1    data1
2    data2
3    data3
4    data4

Сделайте еще один vlookup для любых других столбцов, которые вы хотите перенести с первого листа, затем скройте столбцы с номерами в них.

Answer 2

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

Sub MoveEM2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets("Input")
Set ws2 = Sheets("Output")
On Error Resume Next
Set rng1 = ws1.Columns("B").SpecialCells(xlConstants)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set rng2 = ws2.[b2]
rng1.Copy rng2
'copy column I to Output C2
rng1.Offset(0, 7).Copy rng2.Offset(0, 1)
'copy column N to Output d2
rng1.Offset(0, 12).Copy rng2.Offset(0, 2)
rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site"
Application.ScreenUpdating = True
End Sub

[обновлено для дальнейшего запроса]

Sub MoveEM()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Set ws1 = Sheets("Input")
    Set ws2 = Sheets("Output")
    On Error Resume Next
    Set rng1 = ws1.Range(ws1.[b4], ws1.Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlConstants)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set rng2 = ws2.[b2]
    rng1.Copy
    rng2.PasteSpecial xlPasteValues
    'copy column I to Output C2
    rng1.Offset(0, 7).Copy
    rng2.Offset(0, 1).PasteSpecial xlPasteValues
    'copy column N to Output d2
    rng1.Offset(0, 12).Copy
    rng2.Offset(0, 2).PasteSpecial xlPasteValues
    rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site"
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Answer 3

IRHM,

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

Sub MoveData()
    Sheets("Output").Select
    'Select the input sheet
    OutputRowCounter = Range("A65536").End(xlUp).Row + 1 
     'find the last used row in column A of the output sheet
    Sheets("Input").Select 'Select the input sheet
    InputMaxRow = Range("A65536").End(xlUp).Row 'find the last used row in column A of the input sheet

    For rowLoop = 2 To InputMaxRow 'loop through the file and copy data from columns B-N to output A-M
        If Cells(rowLoop, 2).Value <> "" Then 'if the current cell (changing row and fixed column B) has any data...
            For ColLoop = 2 To 14 'Loop through columns B-N
                Worksheets("Output").Cells(OutputRowCounter, ColLoop - 1).Value = Cells(rowLoop, ColLoop).Value 'copy selected data
           Next ColLoop 'go to next column
             OutputRowCounter = OutputRowCounter + 1 'store the next row in the output sheet
        End If
    Next rowLoop
End Sub

Answer 4

Вот еще один способ сделать это.Это помещает ваши данные в массив, а затем просматривает в массиве строки, имеющие значения в столбце B. Это должно выполняться немного быстрее, чем проходить через столбец / таблицу по ячейкам, но разница, вероятно, будет заметна только для больших данных.комплекты.

Sub summarize()

Dim sIn As Worksheet, sOut As Worksheet, rIn As Range, rOut As Range
Dim inputdata() As Variant
Dim tmpArr(1 To 3) As Variant
Dim i As Long, outcount As Long

Set sIn = Sheets("Input")
Set sOut = Sheets("Output")
Set rIn = sIn.UsedRange
Set rOut = sOut.Range("B2:D2")

'Loads input data into an array for fast processing.
inputdata = rIn.Value
outcount = 0

'Reads data from inputdata Array and prints selected values from columns B, I, and N on Output sheet row by row.
For i = 1 To UBound(inputdata, 1)
    If inputdata(i, 1) <> "" Then
        outcount = outcount + 1
        tmpArr(1) = inputdata(i, 1)
        tmpArr(2) = inputdata(i, 8)
        tmpArr(3) = inputdata(i, 13)
        rOut.Offset(outcount - 1, 0).Value = tmpArr
        Erase tmpArr
    End If
Next i
Erase inputdata
'Add "Scheduled Site" to Column E of Output data.
If sOut.Range("B2") <> "" Then
    sOut.Range("E2") = "Scheduled Site"
    sOut.Range("E2").AutoFill Destination:=sOut.Range("E2", sOut.Range("E2").Offset(outcount - 1, 0))
End If
End Sub