範囲内の空白でないセルをコピーして、1つの列に貼り付けます。

Question

私はかなり新しいvbです。できれば助けてください。私はN5からR24までの範囲のデータを持っていますが、すべてのセルに式が含まれていますが、空白以外のセルはほとんどありません。

空白でないセルだけを列AKにコピーし、列に「/ CA」という文字列を追加したいと思います。列Nのセルがバルクの場合は、最初に列Bに「/ CA 」、以下のように：列AKで

  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 

順序は、それが範囲（：R24 N5）のすべての非空白のセルのデータが含まれているとして、それほど重要ではありません。

次のコードは、私が試したものですが、私は、ペーストした後、列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が "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を増やす必要があります。そうでなければ、同じままになります。