Скопируйте непустую ячейку в диапазоне и вставьте только один столбец

Question

Я довольно новичок в vb, пожалуйста, помогите мне, если сможете. У меня есть ряд данных, начиная с N5 до R24, все ячейки содержат формулы, но лишь немногие из них являются непустыми ячейками.

Я хочу скопировать только те непустые ячейки в столбец AK и добавить к ним строку "/ CA". Если ячейка в столбце N является массовым, сначала добавьте номер в столбце B перед добавлением "/ CA », как показано ниже:

  B   N  O  P  Q  R  S   T 
5     1PLA 2PMC         1PLA/CA 
6 123-01456789 1BULK          2PMC/CA 
7     1AKE        1BULK/123-01456789/CA 
8                1AKE 
9 
10 

порядок в колонке AK не имеет значения, что многое, если она содержит все непустые данные клеточные диапазона (N5: R24).

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

Sub test() 
Dim ws As Worksheet 
Set ws = Sheets("Data") 
LastRow = ws.Cells(Rows.Count, "AK").End(xlUp).Row 
For Each cell In Range("N5:R24") 
If cell.Value <> "" Then 
cell.Copy 
Range("AK" & LastRow + 1).PasteSpecial xlPasteValues 
End If 
Next 
End Sub 

Answer 1

Следующий код, я думаю, сделает то, что вам нужно. (Я не был уверен, был ли столбец B добавлен к выходу только, если вы обрабатывали столбец N или обрабатывали любое значение в строке, где столбец N содержал «BULK». Мой код делает последнее, но я также включал в себя закомментированную версию, чтобы сделать первый.)

Dim cell As Range 
Dim lastRow As Long 
Dim newValue As String 
Dim ws As Worksheet 
Set ws = Sheets("Data") 

With ws 
    'Initialise lastRow to be the last used row in column T 
    lastRow = .Cells(.Rows.Count, "T").End(xlUp).Row 
    'Loop through every cell in the desired range 
    For Each cell In .Range("N5:R24") 
     'Start by setting the new value to be the old value 
     newValue = cell.Value 
     'Only process cells that aren't blank 
     If newValue <> "" Then 
      'Increment row counter for result 
      lastRow = lastRow + 1 
      'Check if column N contains "BULK" 
      If UCase(Mid(.Cells(cell.Row, "N").Value, 2, 4)) = "BULK" Then 
       'If it does, append the contents of column B 
       newValue = newValue & "/" & .Cells(cell.Row, "B").Value 
      End If 
      ''Alternate version if ONLY values in column N need to have column B appended 
      'If UCase(Mid(newValue, 2, 4)) = "BULK" And cell.Column = 14 Then 
      ' 'If it does, append the contents of column B 
      ' newValue = newValue & "/" & .Cells(cell.Row, "B").Value 
      'End If 

      'Append "/CA" 
      newValue = newValue & "/CA" 
      'Store result in column T 
      .Cells(lastRow, "T").Value = newValue 
     End If 
    Next 
End With 

Answer 2

For Each cell In Range("N5:R24") 
If cell.Value <> "" Then 
cell.Copy 
Range("AK" & LastRow + 1).PasteSpecial xlPasteValues 
Range("AK" & LastRow + 1).value = Range("AK" & LastRow + 1).value & "/CA" 
LastRow = LastRow + 1 
End If 
Next 

Вы можете осуществить также ваше другое состояние с предложение if. Также вы будете использовать &, чтобы присоединить строки друг к другу.
Также вы должны увеличить LastRow при каждом цикле, иначе он останется таким же.