コピーセルにテキストが含まれている場合

Question

データがWebフォームからExcelに転送されます。すべてのセルが入力を受け取るわけではありません多くの細胞が存在するため、各細胞をスキャンしてテキストを探すのは時間がかかります。

テキストを自動的にsheet1からsheet2にコピーする方法を教えてください。しかし、私は元のシートと同じレイアウトでセルを表示したくありません。私はそれらを一緒にグループ化して、間にある空のセルをすべて削除したいと思います。私はまた、テキストを含む行からタイトルを取得したいと思います。

私はこのマクロを見つけた：

Sub CopyC() 
Dim SrchRng As Range, cel As Range 
Set SrchRng = Range("C1:C10") 
For Each cel In SrchRng 
    If cel.Value <> "" Then 
     cel.Offset(2, 1).Value = cel.Value 
    End If 
Next cel 

これは、テキストを含むセルのみをつかむが、それは、それはそれを見つけまったく同じレイアウトで表示すべてのヘルプは感謝し、私の多くを救うことになります。将来のスキャン時間、事前に感謝:)

Answer 1

私は、これはあなたが探しているものだと思います。コードの上に

Sub CopyNonBlankCells() 
    Dim cel As Range, myRange As Range, CopyRange As Range 

    Set myRange = Sheet1.Range("C1:C20") '---> give your range here 

    For Each cel In myRange 
     If Not IsEmpty(cel) Then 
      If CopyRange Is Nothing Then 
       Set CopyRange = cel 
      Else 
       Set CopyRange = Union(CopyRange, cel) 
      End If 
     End If 
    Next cel 

    CopyRange.Copy Sheet2.Range("C1") '---> enter desired range to paste copied range without blank cells 
End Sub 

は範囲C1:C20をコピーします~C1~Sheet2

これをhereから取得しました。

EDIT：あなたは

Set myRange = Sheet1.Range("G:G") 
Set myRange = Sheet2.Range("G:G") 

myRange以下のようなものがSheet1.Range("G:G")への最初のセットで、その後になります書きます場合は、以下の答えはあなたのコメント ________________________________________________________________________________

に基づいていますSheet2.Range("G:G")は、電流レンジがmyRangeはSheet2.Range("G:G")です。

複数の範囲を使用する場合は、UNIONの機能を使用することができますが、UNIONを使用する場合は範囲​​が異なるが1つのシートしか結合できないという制限があります。そして、あなたの要件は、異なるシートの範囲を組み合わせることです。これを達成するために、新しいワークシートを追加し、すべてのシートの範囲をG:Gの範囲に追加します。その後、新しく追加されたシートを使用した後、私はそれを削除しています。

次のコードは、Resultという名前のシートに出力します。

Sub CopyNonBlankCells() 
    Dim cel As Range, myRange As Range, CopyRange As Range 

    Dim wsCount As Integer, i As Integer 
    Dim lastRow As Long, lastRowTemp As Long 
    Dim tempSheet As Worksheet 

    wsCount = Worksheets.Count '--->wsCount will give the number of Sheets in your workbook 

    Set tempSheet = Worksheets.Add '--->new sheet added 
    tempSheet.Move After:=Worksheets(wsCount + 1) 

    For i = 1 To wsCount 
     If Sheets(i).Name <> "Result" Then '---> not considering sheet "Result" for taking data 
      lastRow = Sheets(i).Cells(Rows.Count, "G").End(xlUp).Row '--->will give last row in sheet 
      lastRowTemp = tempSheet.Cells(Rows.Count, "G").End(xlUp).Row '--->will give last row in newly added sheet 
      Sheets(i).Range("G1:G" & lastRow).Copy _ 
      tempSheet.Range("G" & lastRowTemp + 1).End(xlUp)(2) 
     End If 
    Next i 

    lastRowTemp = tempSheet.Cells(Rows.Count, "G").End(xlUp).Row 
    Set myRange = tempSheet.Range("G1:G" & lastRowTemp) '--->setting range for removing blanks cells 

    For Each cel In myRange 
     If Not IsEmpty(cel) Then 
      If CopyRange Is Nothing Then 
       Set CopyRange = cel 
      Else 
       Set CopyRange = Union(CopyRange, cel) 
      End If 
     End If 
    Next cel 

    CopyRange.Copy Sheets("Result").Range("G1") '---> enter desired range to paste copied range without blank cells 

    Application.DisplayAlerts = False 
    tempSheet.Delete  '--->deleting added sheet 
    Application.DisplayAlerts = True 
End Sub 

Answer 2

アレイを使用できます。

情報を1つのセルから別のセルにコピーする代わりに、すべての情報をアレイに保存してから、別のシートにアレイを印刷することができます。空のセルを避けるように配列に伝えることができます。通常、配列を使用するのが情報を格納する最良の方法です。 （多くの場合、情報を扱う最も速い方法）

1つの列だけを見る場合、1次元配列を使用できます。複数の列を見て、別のページの対応する列（ただし異なるセル）に情報を印刷する場合は、列番号/必要なものを格納する多次元配列を使用できます。

あなたのコードから、それは次のようになります。

Sub CopyC() 
Dim SrchRng As Range, cel As Range 

'Declare your 1-d array (I don't know what you are storing) 
Dim myarray() as variant 
Dim n as integer 
Dim i as integer 

Set SrchRng = Range("C1:C10") 
'define the number of elements in the array - 1 for now, increase it as we go 
n = 0 
Redim myarray(0 to n) 

For Each cel In SrchRng 
    If cel.Value <> "" Then 
     'redim preserve stores the previous values in the array as you redimension it 
     Redim Preserve myarray(0 to n) 
     myarray(n) = cel.Value 
     'increase n by 1 so next time the array will be 1 larger 
     n = n + 1 
    End If 
Next cel 

'information is now stored, print it out in a loop 
'this will print it out in sheet 2 providing it is called "Sheet2" 
For i = 0 to ubound(myarray) 
    Sheets("Sheet2").cells(i,1).value = myarray(i) 
Next i