Question

为了让我在工作表中复制，我首先需要宏来了解它所属的员工（每个员工都有自己的工作表名称）。在这组要添加的新工作表中，它们是D列中的偶然名称。但是第一个单元格的标题为“参考”，有些具有员工姓名，有些是空白。我想要做的是找到一个带有值的单元格（非空白），并且不包含单词“reference”，因为这只留下了员工的姓名。我想把它复制到L1，这是表格外面的空白单元格

从这里，我可以通过调用L1作为工作表名称参考来将其复制到工作表中。

我所拥有的代码会将参考资料复制到L1，但我不知道如何处理上述员工姓名：

`With Sheet2
    Set Foundcell = Selection.find(What:="Reference", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False)
End With
If Not Foundcell Is Nothing Then
    Foundcell.Copy
    Range("L1").Select
    ActiveSheet.Paste
Else
    MsgBox "There is no tech name in this purchases sheet"
End If
'
End Sub`

Answer 1

如果名称始终位于“Foundcell”正下方的单元格中，其值为“Reference”，那么您只需要在“If Not FoundCell Is Nothing Then”块中执行以下操作。

'Offset the Foundcell by 1 row and check if a value exists
If Foundcell.Offset(1).Value = "" Then
     MsgBox "There is no tech name in this purchases sheet"
Else
'If you follow a .Copy with a space and then a range, 
'it will copy the value into that range without the extra steps.
     Foundcell.Offset(1).Copy ActiveSheet.Range("L1")
End If

如果您的名字不是直接位于下方，但除了“参考”之外，它是列中唯一的其他值，则以下是查找该值的一种方法。

'Use SpecialCells to find all cells with a value in the column where you found Foundcell
Dim rangeWithVal as Range
Set rangeWithVal = Foundcell.EntireColumn.SpecialCells(xlCellTypeConstants)
If rangeWithVal.Count = 1 Then
     'Only the cell with "Reference" was found in the column
     MsgBox "There is no tech name in this purchases sheet"
Else 
     If rangeWithVal.Count > 2 Then
          'More than 2 cells with a value were found.
          MsgBox "Column " + Split(FoundCell.Address(1, 0), "$")(0) + " in this purchases sheet has two or more names"
     Else
         Dim rng as Range
         For Each rng in rangeWithVal
             If rng.Value <> "Reference" Then
                 rng.Copy ActiveSheet.Range("L1")
             End If
         Next rng
     End If
End If

Answer 2

使用查找最后一个单元格，我能够找到最后一个带有emplyees名称的单元格

Sub EmployeeName()

LR = Cells(Rows.Count, "D").End(xlUp).Row
On Error GoTo NoTechName
Cells(LR - 1, 4).Copy
Range("L1").Select
ActiveSheet.Paste
Exit Sub
NoTechName:
MsgBox "There is no tech name in this purchases sheet"
End Sub

轻松完成！感谢你们给我的所有帮助

宏excel查找不包含值或空白的单元格值

2 个答案: