Условное копирование и вставка построчно с помощью vba
С драгоценной помощью @FaneDuru я мог скопировать и вставить содержимое ячейки (которое может включать новые строки с помощью alt+enter) соответственно и отдельно в другой столбец на другом листе с помощью приведенного ниже кода, пока я не добавил в код выделенную жирным шрифтом часть. Моя цель — отсортировать содержимое ячейки, если в столбце C есть строка «НЕТ». Но я получаю ошибку 1004 в этой строке.
Sub Sheet2_Button_Click()
Dim ws As Worksheet, lastR As Long, arr, arrSpl, arrFin, i As Long, j As Long, k As
Long
Set ws = ActiveSheet
lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
arr = ws.Range("A1:A" & lastR).Value2
ReDim arrFin(1 To UBound(arr) * 15, 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" And **ws.Range(“C2:C”) = “NONE”** Then
arrSpl = Split(arr(i, 1), vbLf)
For j = 0 To UBound(arrSpl)
k = k + 1
arrFin(k, 1) = arrSpl(j)
Next j
End If
Next i
If k > 0 Then
Worksheets(sheet1).Range("B:B").ClearContents
Worksheets(sheet1).Range("B1").Resize(k, 1).Value2 = arrFin
End If
End Sub
Да, это именно так.
Хорошо, я подготовлю ответ. Я не помню, в какой столбец другого листа вы хотели вернуться... Если нет быстрого ответа, я буду использовать тот же столбец B:B. Думаю, было бы легко адаптировать его под любую колонку.
Ответы 1
Пожалуйста, попробуйте следующий адаптированный код. Не забудьте указать настоящее имя листа назначения:
Sub splitAndCopyInAnotherColumn()
Dim ws As Worksheet, wDest As Worksheet, lastR As Long, arr, arrSpl, arrFin, i As Long, j As Long, k As Long
Set ws = ActiveSheet: Set wDest = Worksheets("your destination sheet name") 'use here the CORRECT existing destination sheet name
lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
arr = ws.Range("A1:C" & lastR).Value2
ReDim arrFin(1 To UBound(arr) * 15, 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 1) <> "" And UCase(arr(i, 3)) = "NONE" Then
arrSpl = Split(arr(i, 1), vbLf)
For j = 0 To UBound(arrSpl)
k = k + 1
arrFin(k, 1) = arrSpl(j)
Next j
End If
Next i
If k > 0 Then
wDest.Range("B:B").ClearContents
wDest.Range("B1").Resize(k, 1).Value2 = arrFin
End If
End Sub
Пожалуйста, оставьте отзыв после тестирования.
Отредактировано:
Я не могу находиться слишком долго возле своего ноутбука. Итак, поскольку вы не проясняете проблему с листами/столбцом, я подготовил другой столбец обработки версии D:D, если в C:C существует «NONE», и возвращаюсь к другому листу в «A1»:
Sub splitAndCopyInAnotherColumnReversedSheets()
Dim ws As Worksheet, wDest As Worksheet, lastR As Long, arr, arrSpl
Dim i As Long, j As Long, dict As Object
Const searchStr As String = "NONE" 'you can use here any string you need
Set ws = Worksheets("Sayfa2"): Set wDest = Worksheets("Sayfa1") 'use here the CORRECT existing sheet
lastR = ws.Range("D" & ws.Rows.Count).End(xlUp).Row 'last row in column D:D
Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary (able to keep only unique keys)
arr = ws.Range("C1:D" & lastR).Value2
ReDim arrFin(1 To UBound(arr) * 15, 1 To 1)
For i = 1 To UBound(arr)
If arr(i, 2) <> "" And UCase(arr(i, 1)) = searchStr Then
arrSpl = Split(arr(i, 2), vbLf)
For j = 0 To UBound(arrSpl)
dict(arrSpl(j)) = "" 'create dictionary keys only for unique strings!
Next j
End If
Next i
If dict.Count > 0 Then
wDest.Range("A:A").ClearContents 'clear all values in A:A
wDest.Range("A1").Resize(dict.Count, 1).Value2 = Application.Transpose(dict.keys)
wDest.Activate
Else
MsgBox "No any value in D:D containing """ & searchStr & """ in C:C exists..." 'message in case of no returned value
End If
MsgBox "Ready..."
End Sub
Я предполагаю, что это выдало ошибку 9, потому что я изменил имена столбцов. Я внес изменение, чтобы переместить данные из столбца D на листе 2 в столбец A на листе 1, если в столбце «C» на листе 2 не было значения «НЕТ».
@PYC Тогда вам следует только правильно назвать этот второй лист при установке wDest и заменить B на D после If k > 0 Then... И в какой строке кода возникает эта ошибка? Если я правильно понял ваш комментарий... Лист 1 и 2 относительны. Должен ли я понимать, что вы пытаетесь обработать столбцы D и C второго листа и использовать в качестве назначения первый лист, столбец A:A? Я не могу вас достать... Если были другие листы и столбцы, почему вы не указали нужные?
Да, я пытаюсь получить данные из столбца D на листе 2 в соответствии со строковыми значениями в столбце C на листе 2 и перенести данные в столбец A на листе 1. Как вы упомянули, я заменил B на D после k>0, что интересно, хотя ошибки нет, код почему-то не работает.
Я думал, что смогу легко адаптировать код в соответствии со столбцами, над которыми я работаю. Очень сожалею о моей ошибке.
@PYC Когда я пытался предположить, что листы 1 и 2 относительны... И я упомянул (после второго кода), что обрабатываемый лист (столбцы D:D и C:C) будет ws и wDest должен быть листом назначения , тот, куда возвращаться (в «А1»). Итак, вторая версия (после редактирования) должна работать, но если вы понимаете, какой лист должен быть ws, а **другой wDest...
Пожалуйста, не ждите меня, потому что я работаю медленно. Вы можете ответить, когда вам будет удобно. Большое спасибо за вашу ценную помощь и время. Я все еще пробую ваши коды.
Код не выдает ошибки, но почему-то продолжает циклически переходить между этими строками: If arr(i, 1) <> "" And UCase(arr(i, 2)) = "NONE" then и Next i
Но никакой спешки, вы можете писать, когда будете свободны и когда захотите это просмотреть. Я буду ждать тебя, я все равно здесь.
@PYC Во второй версии была ошибка. Столбец C:C находится перед D:D... Я адаптировал соответствующую часть кода. Пожалуйста, протестируйте его и оставьте отзыв. Я код не тестировал и сейчас нет возможности его протестировать, но думаю должно работать...
Следует ли его пересмотреть следующим образом: arr = ws.Range("C1:D" &lastR).Value2 ?
@PYC Это только выглядит красивее (эстетичнее...), но VBA не заботится об этом аспекте. Например, Debug.Print Range("D1:C10").address вернет «C1:D10». Или arr = Range("D1:C10").value, за которым следует Debug.print arr(1,1), вернет значение ячейки «C1». Я должен понимать, что это все равно не работает? Если да, и в вашей книге нет конфиденциальной информации, поделитесь ею, и я отправлю ее обратно с правильным кодом. Сейчас я дома и могу это проверить. Вы можете использовать трансферный сайт. Например, здесь вы можете найти такой сайт, бесплатный и простой в использовании.
Или отправить по почте. Моя личная почта в профиле...
Я отправил вам электронное письмо. Я хотел написать здесь на случай, если оно попадет в нежелательную почту.
@PYC Сейчас я нахожусь в отпуске на острове в Греции, и здесь очень слабый интернет. Получение его займет некоторое время...
Желаю приятного отдыха.
@PYC Я ничего не получил. Ни в Спам... Пожалуйста, проверьте почтовый ящик, на который вы пытались отправить... [email protected]
@PYC Хорошо, я вернулся в отель и нашел файл. Я понимаю (сейчас), что вам нужно сохранять только уникальные значения. Я адаптирую код, используя словарь сценариев, способный сохранять в виде строк только уникальные ключи. Новый код выложу через 5-6 минут...
Это невероятно идеальная работа. Я очень ценю вашу поддержку. Я хотел бы от всей души поблагодарить вас за то, что вы не колебались помочь мне даже во время вашего отпуска. Я желаю, чтобы ваш успех продолжал расти
Итак, понимая, что вам нужно помещать в выходные ячейки из A:A только если в столбце C:C существует строка «Нет», будет ли это правильно?