リストから新しいリスト（MS Excel）にアイテムを追加する

Question

私の以前のqueryを手助けいただきありがとうございます。私は、別のスレッドとして、そしてルール/エチケットに違反しないという希望として、次の障害を取り上げました。

私は今潜在関連する診断のリスト作成検索機能があります：私は行うことができるようにしたいのですがどのような

は、潜在的に関連診断のリストを下に仕事しています隣接するセルに「x」を置くことによって関連性のないものを手動で除去する。検索/選択/ボタンを繰り返して、理想的な世界では

：私は、ボタンを押すと別のシート（名称「リスト」）上のリストに追加されるすべてのチェックを診断のためにしたいと思いますプロセスは単に同じリストに新しい診断を追加するだけです。つまり、 "List"の列の次の空白セルを特定し、そこから実行します。 1つの潜在的な難点は、実際にそこにある式ではなく、各セルから診断テキストをコピーする必要があることです。

ゲイリーの学生は、このスクリプトで以前に同様のqueryに答えていますが、それは、単一のセルからデータを受け取り、テキスト/式の間で区別していないとして、それはかなり十分に私を得ることはありません。

Sub ButtonCode() 
    Dim N As Long 
    N = Cells(Rows.Count, "A").End(xlUp).Row + 1 
    Cells(N, "A").Value = Range("C3").Value 
End Sub 

誰も助けることができますか？

Answer 1

次のように試してみるとよいでしょう。 .Offsetプロパティを使用して、すべての 'x'チェックマークで指定したセルをつかむことができます。以下のコード：

Sub move_diagnoses() 
Dim diagnosesheet As Worksheet 
Dim copysheet As Worksheet 
Dim last_diagnosis_row As Integer 
Dim last_list_row As Integer 
Dim loserange As Range 
Dim losecell As Range 

'Set your worksheets first 
Set diagnosesheet = Worksheets("Diagnoses") 
'I titled the worksheet you have the diagnoses on as 'Diagnoses' since you didn't specify 
Set copysheet = Worksheets("List") 

'Now set the range (i.e. collection of cells) that enumerate all the potential diagnoses 
'First find the last row in the diagnoses column 
'Then find the last used row in the 'List' worksheet 
last_diagnosis_row = diagnosesheet.Range("E" & Rows.Count).End(xlUp).Row 
last_list_row = diagnosesheet.Range("A" & Rows.Count).End(xlUp).Row 
Set loserange = diagnosesheet.Range("D2:D" & last_diagnosis_row) 
'Notice the loserange (i.e. the range that contains the all the checkmarks is defined from D2 onwards 

For Each losecell In loserange.Cells 
    If Trim(losecell.Value) = "x" Then 
     copysheet.Cells(last_list_row, 1).Value = losecell.Offset(0, 1).Text 
     copysheet.Cells(last_list_row, 2).Value = losecell.Offset(0, 2).Text 
     last_list_row = last_list_row + 1 
    End If 
Next losecell 


End Sub