将列表中的项目附加到新列表（MS Excel）

谢谢大家对我以前的查询提供帮助。 我把我的下一个障碍作为一个单独的线索，并希望不违反任何规则/礼节。

我现在有一个search工具可以创build一个潜在的相关诊断列表：

我希望能够做的是在可能相关的诊断列表中进行处理，并通过在相邻单元中放置“x”来手动消除那些不相关的诊断。 然后，我想按下一个button，并将所有检查的诊断附加到另一张纸上的列表（标题为“列表”）：

在理想的情况下，重复search/select/button过程将简单地将新的诊断添加到相同的列表中，即识别“List”列中的下一个空白单元并从那里继续。 一个潜在的困难是我需要从每个细胞中复制诊断文本，而不是实际存在的公式。

加里的学生以前用这个脚本回答了一个类似的查询 ，但是它并没有让我足够远，因为它从一个单元格获取数据，并且不区分文本/公式：

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 (ie 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 (ie 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