复制并粘贴到另一个工作表 Excel vba 中的新列

Question

我在工作表 1 上有数据，时间在 A 列和当前 B 列。多次运行的数据都在一个列中，所以我想将每个运行分成一个新列。

测量值是可变长度的，所以我希望 excel 在 A 列中找到 0 值并将相应的值复制到 b 列中，直到在 a 列中找到新的 0 值到工作表 2 中的新列。

到目前为止，excel 将成功找到 b 列中的数据并将其复制到 sheet2 但它通过重复复制粘贴来填充整个列，直到我复制数据的所有列都被填充，除了第一个和最后一栏。我怎样才能解决这个问题？这是我目前所拥有的：

    Sub CopyValuestoSheet2()
Dim strsearch As String
Dim lastline As Integer
Dim tocopy As Integer
Dim StartValue As Integer
Dim FinishValue As Integer
Dim Col2 As Integer
Dim TempValue As Integer
Dim EndValue As Integer

strsearch = CStr(InputBox("enter time to search for (usually 0)"))
lastline = Range("A65536").End(xlUp).Row
Col2 = 1
TempValue = 1

For i = 2 To lastline
    'This part selects the data in column B based off of finding the value in column A
    For Each c In Range("A" & i & ":A" & i)
        If InStr(c.Text, strsearch) Then
            tocopy = 1
            StartValue = TempValue
            FinishValue = i
            TempValue = FinishValue
            FinishValue = FinishValue - 1
        End If
    Next c
'Here is where I actually copy the data over
 If tocopy = 1 Then
        'I want to copy the range row StartValue to row FinishValue in column B
        Range("B" & StartValue & ":B" & FinishValue).Copy
    'I want to paste it to a new column each time
        Paste Destination:=Sheets(2).Columns(Col2)
        Col2 = Col2 + 1
        Sheets("Sheet1").Select
    End If
tocopy = 0
Next i
    'Printing the last data point since there is no 0 after the final entry.
    'This part works fine even though it is just a copy-paste of the If statement
        FinishValue = FinishValue + 1
        'This will fail if the last datapoint has more thatn 500 enteries
        EndValue = FinishValue + 500
        Range("B" & FinishValue & ":B" & EndValue).Copy
        Sheets("Sheet2").Select
        Paste Destination:=Sheets(2).Columns(Col2)
        Sheets("Sheet2").Select

End Sub

Answer 1

这应该更好：

Sub CopyValuestoSheet2()
    Dim strsearch As String
    Dim lastline As Integer
    Dim tocopy As Integer
    Dim StartValue As Integer
    Dim FinishValue As Integer
    Dim Col2 As Integer
    Dim TempValue As Integer
    Dim EndValue As Integer

strsearch = CStr(InputBox("enter time to search for (usually 0)"))
lastline = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Col2 = 1
TempValue = 1

For I = 2 To lastline
    'This part selects the data in column B based off of finding the value in column A
    For Each c In Range("A" & I & ":A" & I)
        If InStr(c.Text, strsearch) Then
            tocopy = 1
            StartValue = TempValue
            FinishValue = I
            TempValue = FinishValue
            FinishValue = FinishValue - 1
        End If
    Next c
'Here is where I actually copy the data over
 If tocopy = 1 Then
        'I want to copy the range row StartValue to row FinishValue in column B
        Range("B" & StartValue & ":B" & FinishValue).Copy
    'I want to paste it to a new column each time
        Paste Destination:=Sheets(2).Range(ColLet(Col2) & "$1:$" & ColLet(Col2) & (FinishValue - StartValue + 1))
        Col2 = Col2 + 1
        Sheets("Sheet1").Select
    End If
tocopy = 0
Next I
    'Printing the last data point since there is no 0 after the final entry.
    'This part works fine even though it is just a copy-paste of the If statement
        FinishValue = FinishValue + 1
        'This will fail if the last datapoint has more thatn 500 enteries
        EndValue = Range("B" & FinishValue).End(xlDown).Row
        Range(Range("B" & FinishValue), Range("B" & EndValue)).Copy

        Paste Destination:=Sheets(2).Range(ColLet(Col2) & "$1:$" & ColLet(Col2) & (EndValue - FinishValue + 1))


End Sub

为了您的信息，.select 是一个非常贪婪的（在资源中）并且通常无用的命令，所以尽量避免它！ ;)

Public Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
    ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function