时间戳

首页 > 解决方案 > Excel VBA代码将结果粘贴到错误的范围内

excel - Excel VBA代码将结果粘贴到错误的范围内

问题描述

将一个范围复制到另一个范围的脚本。但是，当我尝试将范围从 Sheet1 复制到 Sheet2 时，结果不会粘贴到 J 列中，而是以 8 列（R 列）的偏移量粘贴。我不明白为什么？RowCountSummary 和 ColumnCountSummary 都设置为 0，即范围的第一个索引？

Sub InsertForecastData()

  Dim ColumnsCount As Integer
  Dim ColCounter As Integer
  Dim RowsCount As Integer
  Dim ForeCastRange As Range
  Dim ForecastWS As Worksheet
  Dim SummaryWs As Worksheet
  Dim PasteRange As Range
  Dim ColumnCountSummary As Integer
  Dim RowCountSummary As Integer

  ColumnsCount = 300
  ColCounter = 0
  RowsCount1 = 0
  RowsCount2 = 47
  ColumnCountSummary = 0
  RowCountSummary = 0

  Do While ColCounter <= ColumnsCount

  Worksheets("Sheet1").Select
  Set ForeCastRange = Worksheets("Sheet1").Range("B2:KN49")
  With ForeCastRange
    .Range(.Cells(RowsCount1, ColCounter), .Cells(RowsCount2, ColCounter)).Copy
  End With

  Worksheets("Sheet2").Select
  Set PasteRange = Worksheets("Sheet2").Range("J2:J13915")
  With PasteRange
    .Range(.Cells(RowCountSummary, ColumnCountSummary), .Cells(RowCountSummary + RowsCount2, ColumnCountSummary)).PasteSpecial
  End With

  RowCountSummary = RowCountSummary + 48
  ColCounter = ColCounter + 1

  Loop

End Sub

标签： excelvba

解决方案

以前遇到过这种行为，可以通过这个简单的演示看到

Sub test()
  With Sheet1.Range("J3:J100")
    Debug.Print .Range(.Cells(0, 0), .Cells(47, 0)).Address
  End With
End Sub

结果为 4 美元：51 美元。如果对列 B 到 J 重复运行，则结果为 B、D、F、H、J、L、N、P，显示加倍效果。我认为 B 可以，因为列号为零。

您可以通过设置 RowCountSummary = 1 和 ColumnCountSummary = 1 并添加 .parent 来修复您的代码

With PasteRange
  .Parent.Range(.Cells(RowCountSummary, ColumnCountSummary), _
  .Cells(RowCountSummary + RowsCount2, ColumnCountSummary)).PasteSpecial

结束于

或者你可以试试这个

Sub InsertForecastData1()

  Const columnCount As Integer = 3
  Const rowCount As Integer = 48
  Const sourceCol As String = "B"
  Const targetCol As String = "J"
  Const startRow As Integer = 2
  Const records As Integer = 300

  Dim rngSource as Range, rngTarget As Range
  Dim start as Single, finish as Single
  Set rngSource = Worksheets("Sheet1").Range(sourceCol & startRow)
  Set rngSource = rngSource.Resize(rowCount, columnCount)
  Set rngTarget = Worksheets("Sheet2").Range(targetCol & startRow)

  start = Timer
  Application.ScreenUpdating = False

  Dim i As Integer
  For i = 1 To records
    'Debug.Print rngSource.Address, rngTarget.Address
    rngSource.Copy rngTarget
    Set rngSource = rngSource.Offset(rowCount, 0)
    Set rngTarget = rngTarget.Offset(rowCount, 0)
  Next i

  Application.ScreenUpdating = True
  finish = Timer
  MsgBox "Completed " & records & " records in " & finish - start & " secs"

End Sub

请参阅文档的备注部分

推荐阅读