複製並粘貼到另一張表中的新列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