复制并粘贴到另一张表中的新列Excel VBA

Question

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

测量是可变长度，所以我希望Excel找到在列A中的0值和复制在列B中的相应的值，直到新的值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 

并为您的信息，是。选择一个非常贪婪（在ressources）和generaly无用的命令，所以要尽量躲开它！ ;）

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