VBAを繰り返すExcelのそれ以降の列を検索

Question

コードからわかるように、私はVBAの新機能ですので、愚かな質問であれば謝ります。

グローバル変数Verb1で指定されたテキスト文字列に対して1つのワークシート（RawData）を表示し、別のワークシート（Verbatim）の最初の空の列に貼り付けるコードブロックが必要です。

私の難しさは、Verb1に格納されている文字列がRawDataで1、2、または3回表示される可能性があるためです。複数の列をチェックするFind関数が必要です。

しかし、私のコードが実際に行っていることは、文字列の最初の出現を保持する列をコピーし、それを検索範囲内の列の数に等しい数だけ貼り付けることです...この場合、 688回。

コードがFor ... Nextステートメントなしで動作することを確認しました（つまり、文字列が最初に見つかった場合は、それをVerbatimワークシートの最初の空白の列に貼り付けます）。このステートメントでエラーが何であるかを参照してください。

Public Verb1 As String 

Sub Paste2() 

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim aCell As Range 
Dim NextCol As Long 

Set ws1 = ThisWorkbook.Sheets("RawData") 
Set ws2 = ThisWorkbook.Sheets("Verbatim") 
Set Rng = ThisWorkbook.Sheets("RawData").Range("A1:ZZ1") 
NextCol = 0 

Worksheets("RawData").Activate 
With ws1 
'Copy and Paste Verbatim 
For Each Cell in Rng 
    NextCol = NextCol + 1 
    Set aCell = Worksheets("RawData").Range("A1:ZZ1").Find(What:=Verb1, 
    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False) 
    aCell.EntireColumn.Copy ws2.Cells(1, NextCol) 
Next Cell 
End With 
End Sub 

誰でも正しい方向に向けることができますか？

ご協力いただきありがとうございます。

Answer 1

はここ.FindNextを使用して、別の方法であり、あなたのコードの一部をクリーンアップ：あなたが情報をコピーしなければならない回数を確認するために迅速なCOUNTIF()を追加することができます。

Option Explicit 

Public Verb1 As String 

Sub Paste2() 

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim aCell As Range 
Dim Rng As Range 
Dim NextCol As Long 
Dim sFirstAddress As String 

Set ws1 = ThisWorkbook.Sheets("RawData") 
Set ws2 = ThisWorkbook.Sheets("Verbatim") 
Set Rng = ThisWorkbook.Sheets("RawData").Range("A1:ZZ1") 
NextCol = 0 

'No need to "Activate" 
'Worksheets("RawData").Activate 

With Rng 
'Copy and Paste Verbatim 
    Set aCell = .Find(what:=Verb1, after:=Rng.End(xlToRight), LookIn:=xlValues, _ 
      lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlNext, _ 
      MatchCase:=False) 
    If Not aCell Is Nothing Then 
     sFirstAddress = aCell.Address 
     NextCol = NextCol + 1 
     aCell.EntireColumn.Copy ws2.Cells(1, NextCol) 

     Do 
      Set aCell = .FindNext(aCell) 
      If Not aCell.Address = sFirstAddress Then 
       NextCol = NextCol + 1 
       aCell.EntireColumn.Copy ws2.Cells(1, NextCol) 
      End If 
     Loop Until sFirstAddress = aCell.Address 
    End If 
End With 

End Sub 

Answer 2

あなたはSet aCellにAfterのためのオプションを追加する必要があります

まず、右With文の前に、Set aCell = rng.Cells(1, 1)を追加します。その後Set aCellに切り替える：

また

Set aCell = Worksheets("RawData").Range("A1:ZZ1").Find(What:=Verb1, _ 
    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False, after:=aCell) 

は、よりエレガントな方法があるかもしれないが、あなたは、文字列のすべてのインスタンスを見つけた場合は、関係なく、範囲内のセルをループしているので、あなた

Sub Paste2() 

Dim ws1  As Worksheet, ws2  As Worksheet 
Dim aCell As Range, rng As Range, cel As Range 
Dim NextCol As Long, numOccur As Long 

Set ws1 = ThisWorkbook.Sheets("RawData") 
Set ws2 = ThisWorkbook.Sheets("Verbatim") 
Set rng = ThisWorkbook.Sheets("RawData").Range("A1:ZZ1") 
NextCol = 0 

numOccur = Application.WorksheetFunction.CountIf(rng, Verb1) 

Set aCell = rng.Cells(1, 1) 
With ws1 
    'Copy and Paste Verbatim 
    For Each cel In rng 
     NextCol = NextCol + 1 
     Set aCell = .Range("A1:ZZ1").Find(What:=Verb1, LookIn:=xlValues, LookAt:=xlPart, _ 
      MatchCase:=False, SearchFormat:=False, SearchDirection:=xlNext, After:=aCell) 
     Debug.Print Verb1 & " found in cell " & aCell.Address 
     aCell.EntireColumn.Copy ws2.Cells(1, NextCol) 
     If NextCol = numOccur Then Exit For 
    Next cel 
End With 
End Sub