复制列中的特定值

Question

我需要一些VBA帮助。我想复制列中的值。 参考图片，我想在值为＆＃34; Dept / Branch code：144＆＃34;时开始复制。因为这是唯一的值是一致的并且停止复制，直到单元格值为＆＃34; Total＆＃34;。请帮忙！！！！我无法使用范围进行复制，因为te范围在其他工作簿中可能不一致。

Sub Copycolumn()
For i = 1 To 100
If Left(Cells(i, "A").Value, 21) = ("Dept/Branch code: 144") Then
Cells(i, "A").Copy Destination:=Range("C1")
End If
Next
End Sub 

Answer 1

如果要在新列表中保存单元格的位置，请尝试此操作

Cells(i, "A").Copy Destination:=Range("C" & i)

如果你想在新列表中创建单元格，那么你的代码应该是这样的：

Sub Copycolumn()
n = 0
For i = 1 To 100
If Left(Cells(i, "A").Value, 21) = ("Dept/Branch code: 144") Then
n = n + 1
Cells(i, "A").Copy Destination:=Range("C" & n)
End If
Next
End Sub 

Answer 2

你可以使用范围！下面的代码将找到开始复制的第一行，然后使用它来查找＆＃34; Total *＆＃34;的第一个实例，然后将该范围复制到单元格C1

Sub gogo()
    START_ROW = Application.WorksheetFunction.Match("Dept/Branch code: 144*", Range("A:A"), 0)
    END_ROW = Application.WorksheetFunction.Match("Total*", Range("A" & START_ROW & ":A5000"), 0) + START_ROW - 1
    Range("A" & START_ROW & ":A" & END_ROW).Copy
    Range("C1").PasteSpecial
End Sub

此代码不使用任何循环，它只是利用Excel内置的超快速功能来查找MATCH，因此如果你有一张表有一个MATCH，它会快得多吨条目

另请注意，在＆＃34; Total＆＃34;结尾处使用外卡*和＆＃34;部门/分行代码：144＆＃34;做这场比赛所以你不必去除弦乐。

Answer 3

您可以使用Range对象，您可以使用Find功能查找"Dept/Branch code: 144"的第一个单元格以及要复制的最后一个单元格"Total"。

<强>代码

Option Explicit

Sub Copycolumn()

Dim StartRng As Range, FinishRng As Range, CopyRng As Range

With Sheets("Sheet1") ' modify "Sheet1" to your sheet's name
    Set StartRng = .Columns(1).Find(what:="Dept/Branch code: 144", LookIn:=xlValues, LookAt:=xlPart)
    If StartRng Is Nothing Then ' check if Find failed
        MsgBox "Unable to Find `Dept/Branch code: 144`", vbCritical
        Exit Sub
    End If

    Set FinishRng = .Columns(1).Find(what:="Total", LookIn:=xlValues, LookAt:=xlPart)
    If FinishRng Is Nothing Then ' check if Find failed
        MsgBox "Unable to Find `Total`", vbCritical
        Exit Sub
    End If

    ' set the range to be copied
    Set CopyRng = .Range(.Cells(StartRng.Row, 1), .Cells(FinishRng.Row, 1))

    ' copy the Range
    CopyRng.Copy Destination:=.Range("C1")

End With

End Sub

Answer 4

如果您的“部门/分支代码”没有重复项，您可以在一行中完成所需的工作

Columns(1).Find("*144*", , xlValues, xlWhole).Resize(10).Copy Range("C1")