如何在粘貼數組之前插入一行

我目前有一個數組，我使用宏填充並粘貼在名爲「T1」的工作表中。我當前的宏使用rowcount函數來確定使用的行並從下一個可用行粘貼數組。如何在粘貼數組之前插入一行

我遇到的問題是，當我粘貼這個數組多次，數組需要間隔一排，以便我可以區分不同的提交。這是我到目前爲止，我希望有人能幫助我：

Sub CopyData() 

    Dim Truearray() As String 
    Dim cell As Excel.Range 
    Dim RowCount1 As Integer 
    Dim i As Integer 
    Dim ii As Integer 
    Dim col As Range 
    Dim col2 As Range 
    i = 0 
    ii = 2 

    RowCount1 = DHRSheet.UsedRange.Rows.Count 
    Set col = DHRSheet.Range("I1:I" & RowCount1) 

    For Each cell In col 

     If cell.Value = "True" Then 

      Dim ValueCell As Range 
      Set ValueCell = Cells(cell.Row, 3) 
      ReDim Preserve Truearray(i) 
      Truearray(i) = ValueCell.Value 

      Dim siblingCell As Range 
      Set siblingCell = Cells(cell.Row, 2) 
      Dim Siblingarray() As String 

      ReDim Preserve Siblingarray(i) 
      Siblingarray(i) = DHRSheet.Name & "$" & siblingCell.Value 

      i = i + 1 

     End If 

    Next 

    Dim RowCount2 As Integer 

    RowCount2 = DataSheet.UsedRange.Rows.Count + 1 

    For ii = 2 To UBound(Truearray) 
     DataSheet.Cells(RowCount2 + ii, 2).Value = Truearray(ii) 
    Next 

    For ii = 2 To UBound(Siblingarray) 
     DataSheet.Cells(RowCount2 + ii, 1).Value = Siblingarray(ii) 
    Next 

    DataSheet.Columns("A:B").AutoFit 

    MsgBox ("Data entered has been successfully validated & logged") 

End Sub

來源

2012-07-24 user1452091

請勿使用USEDRANGE。用這個方法找到lastrow，然後簡單地加1。 http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba – 2012-07-24 14:49:29

我真的不明白這個問題，因爲代碼似乎已經做了它應該做的。在執行該行時：Count2 = DataSheet.UsedRange.Rows.Count + 1，在開始填寫TrueArray和SiblingArray之前創建一個空行。如果要多次粘貼數組（例如，在循環中），則可以在每次粘貼數組後重新定義usedRange。這不會解決你的問題嗎？ – Trace 2012-07-24 14:56:11

- 或者你可以重新定義最後一個單元格。 – Trace 2012-07-24 14:57:30

如果偏移從底部電池兩行，你會離開分離的空行。您還應該考慮將整個數組填充爲基數1並將其一次性寫入DataSheet。

Sub CopyData2() 

    Dim rCell As Range 
    Dim aTrues() As Variant 
    Dim rRng As Range 
    Dim lCnt As Long 

    'Define the range to search 
    With DHRSheet 
     Set rRng = .Range(.Cells(1, 9), .Cells(.Rows.Count, 9).End(xlUp)) 
    End With 

    'resize array to hold all the 'trues' 
    ReDim aTrues(1 To Application.WorksheetFunction.CountIf(rRng, "True"), 1 To 2) 

    For Each rCell In rRng.Cells 
     If rCell.Value = "True" Then 
      lCnt = lCnt + 1 
      'store the string from column 2 
      aTrues(lCnt, 1) = DHRSheet.Name & "$" & rCell.Offset(0, -7).Value 
      'store the value from column 3 
      aTrues(lCnt, 2) = rCell.Offset(0, -6).Value 
     End If 
    Next rCell 

    'offset 2 from the bottom row to leave a row of separation 
    With DataSheet.Cells(DataSheet.Rows.Count, 1).End(xlUp).Offset(2, 0) 
     'write the stored information at one time 
     .Resize(UBound(aTrues, 1), UBound(aTrues, 2)).Value = aTrues 
    End With 

End Sub

來源

2012-07-24 15:42:30

不錯，像往常一樣 - 評論的好事情，這將有助於OP – JMax 2012-07-24 17:10:44

如何在粘貼數組之前插入一行

回答

相關問題