#excel
#excel
Вопрос:
Я пытаюсь написать макрос, который копирует строку, если ячейка в этой строке содержит текст (например: Мумбаи, Дели и т.д.) Из столбца C.
Например, если есть 30 строк, но только 15 содержат текст (Мумбаи и Дели) в столбце C. Я хочу скопировать эти 15 строк и вставить их в «Sheet2», я использовал приведенный ниже код. однако он копирует все заполненные строки. однако мое требование заключается в том, что коду нужно скопировать только столбцы a, b, c, d, f, g, h, i, l amp; m на Лист2.
Sub testPasteinSh2()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range
Dim rngCopy As Range, lastR1 As Long, lastR2 As Long
Dim strSearch1 As String, strSearch2 As String
strSearch1 = "Mumbai" 'or combo value...
strSearch2 = "Delhi" 'or something else...
Set sh1 = ActiveSheet 'use here your worksheet
Set sh2 = Worksheets("Sheet2") 'use here your sheet
lastR1 = sh1.Range("C" amp; Rows.count).End(xlUp).Row
lastR2 = sh2.Range("A" amp; Rows.count).End(xlUp).Row 1
Set rng = sh1.Range("C2:C" amp; lastR1)
For Each cel In rng.cells
If cel.Value = strSearch1 Or cel.Value = strSearch2 Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Rows(cel.Row)
Else
Set rngCopy = Union(rngCopy, sh1.Rows(cel.Row))
End If
End If
Next
If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.cells(lastR2, 1)
End If
End Sub
Не могли бы вы, пожалуйста, помочь мне. Заранее благодарю вас.
Комментарии:
1. Ваш фактический код копирует всего 1 ячейку, но в вашем вопросе вы говорите … макрос, который копирует строку … . Пожалуйста, укажите, строка данных или отдельная ячейка
2. a, b, c, d, f, g, h, i, l amp; m на Лист2 Хорошо, но вы хотите вставить их в те же столбцы? это оставило бы пробелы… Или их следует вставлять одну за другой?
3. Приведенный выше код работает нормально, и он не оставляет пробелов между столбцами. В моем исходном столбце данных D есть пустые ячейки. Значения ячеек столбца D доступны в столбце H как ноль, или 1, или 2 и т.д. Я хочу, чтобы код должен «копировать строки со значением больше нуля в столбце H.
Ответ №1:
Кажется, сложно задать четкий вопрос…
Оказывается, я знаю, что вам нужно, из предыдущего вопроса. Предположим, что вы не передумали, пожалуйста, протестируйте следующий код:
Sub testPasteinSh2Bis()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range
Dim rngCopy As Range, lastR1 As Long, lastR2 As Long
Dim strSearch1 As String, strSearch2 As String
'a, b, c, d, f, g, h, i, l 'columns to be copied
strSearch1 = "Mumbai" 'or combo value...
strSearch2 = "Delhi" 'or something else...
Set sh1 = ActiveSheet 'use here your worksheet
Set sh2 = sh1.Next 'use here your sheet
lastR1 = sh1.Range("C" amp; Rows.count).End(xlUp).Row
lastR2 = sh2.Range("A" amp; Rows.count).End(xlUp).Row 1
Set rng = sh1.Range("C2:C" amp; lastR1)
For Each cel In rng.cells
If cel.Value = strSearch1 Or cel.Value = strSearch2 Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Range(sh1.Range("A" amp; cel.Row amp; ":D" amp; cel.Row).Address amp; "," amp; _
sh1.Range("F" amp; cel.Row amp; ":I" amp; cel.Row).Address amp; "," amp; sh1.Range("L" amp; cel.Row).Address)
Else
Set rngCopy = Union(rngCopy, sh1.Range(sh1.Range("A" amp; cel.Row amp; ":D" amp; cel.Row).Address amp; "," amp; _
sh1.Range("F" amp; cel.Row amp; ":I" amp; cel.Row).Address amp; "," amp; sh1.Range("L" amp; cel.Row).Address))
End If
End If
Next
If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.cells(lastR2, 1)
End If
End Sub
Он должен скопировать столбцы a, b, c, d, f, g, h, i, l для соответствующих случаев…
Комментарии:
1. Большое вам спасибо за помощь с этим запросом. Это экономит мне так много времени на моей обычной работе. пожалуйста, нужна дополнительная помощь. Каждый раз, когда я получаю данные, в столбце D. В столбце D значения ячеек перечислены в H как ноль. однако иногда будет получено значение (число, отличное от нуля) в столбце H для пустых ячеек столбца D. Возможно ли изменить код, который не может копировать пустые строки с нулевым значением.
2. @Shalini Reddy: Я не понимаю, о чем вы говорите. Все значения из столбца D: D первого листа копируются в столбец D: D второго. Что должно означать «не копировать пустые строки с нулевым значением»? Ни одна из пустых строк не будет скопирована! Код копирует только запрошенный диапазон (столбцы a, b, c, d, f, g, h, i) если в конкретной строке найдено искомое слово . Таким образом, он не может быть пустым. Затем, вы сказали что-нибудь в своем вопросе о некоторых пустых строках и что бы означала эта пустота?
3. Спасибо за помощь! Второй код ответил на мой вопрос. @FaneDuru
4. @Shalini Reddy: Хорошо. Теперь, что делает код, даже отвечающий на ваш вопрос, но не удобный для вас, и его следует улучшить? Но попробуйте четко объяснить проблему… Если это только деталь, я адаптирую код. Боюсь, если это изменит значение вопроса, вам следует задать другой вопрос. Таковы правила сообщества…
5. Приведенный выше код отлично подходит для этого вопроса. Кроме того, ваш предыдущий код ответил на предыдущий вопрос. Если мне потребуется дополнительная помощь или изменение в этом коде, я вызову новый запрос. Еще раз спасибо @FaneDuru
Ответ №2:
Вы могли бы попробовать это:
Sub Macro1()
Dim lastrow As Long, erow As Long
Dim rng1 As Range
Dim rng2 As Range
'choose an empty column, in my example is O.
With Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("O2:O" amp; lastrow).FormulaR1C1 = "=IF(OR(RC[-12]=""Mumbai"",RC[-12]=""Delhi""),1,"""")" 'here is -12 because difference between column C and O is 3. Change it according your needs
Set rng1 = .Range("O2:O" amp; lastrow).SpecialCells(xlCellTypeFormulas, 1)
For Each rng2 In rng1.Cells
erow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Range("A" amp; erow 1 amp; ":M" amp; erow 1) = .Range("A" amp; rng2.Row amp; ":M" amp; rng2.Row).Value 'this will copy the full row of data from A to M
Next rng2
Set rng1 = Nothing
.Range("O2:O" amp; lastrow).Clear
End With
'delete the columns copied but you don't want like E, J,K
With Worksheets("Sheet2")
.Columns("E:E").Delete
.Columns("J:K").Delete
End With
End Sub
Этот код скопирует строку данных и удалит ненужные столбцы.
В случае, если это невозможно, вы можете скопировать отдельные диапазоны. Вы могли бы заменить строку
Worksheets("Sheet2").Range("A" amp; erow 1 amp; ":M" amp; erow 1) = .Range("A" amp; rng2.Row amp; ":M" amp; rng2.Row).Value 'this will copy the full row of data from A to M
с помощью
Worksheets("Sheet2").Range("A" amp; erow 1).Value = .Range("A" amp; rng2.Row).Value 'a single cell
Вероятно, вы можете адаптировать это к своим потребностям.
Комментарии:
1. Я хочу добавить заголовки столбцов к скопированным строкам. Не могли бы вы, пожалуйста, помочь предложить мне код. Я попробовал Activesheet (sh1). Диапазон («A6»). Скопируйте _ Worksheets(«Sheet1»).Range («A1»), но это не сработало