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

Question

为了使我在表格上复制，我首先需要宏来知道它属于哪个员工（每个员工都有自己的表格名称）。在这组新的床单中，它们是D。第一个单元格中的偶尔名称。但是，标题"参考"有些具有员工名称，有些则是空白的。我想做的是找到一个具有值的单元格（不是空白），并且不包含"参考"一词，因为这只是留下员工的名称。我想将其复制到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

如果名称始终在您的" fundcell"的单元格中，其值为"参考"，那么您只需要在"如果没有unstrecell是一无所有）中进行以下操作块。

'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

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