空白と空白の行を頭と尾のループとして使用してリストをコピーします

Question

こんにちは、私はコピーしたいデータのセットを持っています。基本的には、if関数を作成したいと思います。 B列の空行を検索して空白の場合は、次の行にループし、最初の空白でない行まで続行します。非ブランクに達した場合は、列cのすべての空白行からすべてのセルをコピーします。

Sub NotReadys() 

' NotReadys Macro' 
Dim Z As Integer 'Supplier Beginning Row' 
Dim X As Integer 'Next Non Blank row' 
Dim Q As Integer '# of suppliers' 
Dim Y As Integer 'Paste Row' 
Y = 6 
'For T = 1 To 195 


ActiveWindow.SmallScroll Down:=-33 


Range("B" & Y).Select 
Selection.Copy 

Range("E" & Y).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("F" & Y).Select 
Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = "=TEXTJOIN(CHAR(10),FALSE,RC[-3]:R[30]C[-3])" 
Range("F" & Y).Select 
ActiveWindow.SmallScroll Down:=-30 
Range("F" & Y).Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Y = Y + 1 
    Next T 

    End Sub 

http://imgur.com/XGwB4XR

Answer 1

私は困難あなたのデータの構造を理解したんだけど、For Each x In Selectionを使用すると、あなたを助けるかもしれません。私は仮定していること、あなたのデータを、少なくとも以下、サプライヤ名が列Aにあり、およびPOSが列Bのどこにいるか似て

このコードは、POが空白でない任意のサプライヤーとPOを（コピーされます

 
    | A | B | C | D | 
-----|-------|-------|-------|-------| 
    1 | s1 | PO1 |  |  | 
-----|-------|-------|-------|-------| 
    2 | s2 | PO2 |  |  | 
-----|-------|-------|-------|-------| 
    3 | s3 |  |  |  | 
-----|-------|-------|-------|-------| 
    4 | s4 | PO3 |  |  | 
-----|-------|-------|-------|-------| 

）をC列とD列に変更してください。

outRow = 1 ' Set this to the index of the first row you want to output to 

' Run through each cell in Selection, left to right, top to bottom 
For Each selCell In Selection 
    ' Check for non-blank, but only if we're looking at column 2 (B) 
    If selCell.Column = 2 & selCell <> "" then 
    ' Store the selected Row and Column 
    sRow = selCell.Row 
    sCol = selCell.Column 

    ' Has the effect of prefixing ActiveSheet to any values that start with "." 
    With ActiveSheet 
     ' Copy value from cols 1 and 2 (A & B) to col 3 and 4 (C & D) 
     .Cells(outRow, 3).Value = .Cells(sRow, sCol - 1).Value 
     .Cells(outRow, 4).Value = selCell.Value 
    End With 

    outRow = outRow +1 ' Moves to next output row 
    End If 
Next 

私の例では、関数を実行する前にA1：B4を選択したと仮定すると、以下の出力が得られます。

 
    | A | B | C | D | 
-----|-------|-------|-------|-------| 
    1 | s1 | PO1 | s1 | PO1 | 
-----|-------|-------|-------|-------| 
    2 | s2 | PO2 | s2 | PO2 | 
-----|-------|-------|-------|-------| 
    3 | s3 |  | s4 | PO3 | 
-----|-------|-------|-------|-------| 
    4 | s4 | PO3 |  |  | 
-----|-------|-------|-------|-------| 

私はあなたが持っているコードを生成するためにマクロ記録オプションを使用していると思います。これはVBAの仕組みを学ぶのに最適な方法です（私たちのほとんどはある時点でこれを行っています）が、素晴らしいコードを生成するわけではありません。 Excelに組み込まれたドキュメントは、実際には本当に優れており、レコーダーの限界にぶつかったときに検討する価値があります。

編集：あなたの質問をもっと見るほど、私はあなたが尋ねていることについては不明ですが、うまくいけば少なくともあなたは正しい方向にあなたを押してくれるでしょう。