如何使用VBA在Excel中用较小范围的数据填充范围

时间:2018-11-05 03:07:25

标签: excel vba excel-vba excel-2010

2 个答案:

答案 0 :(得分:1)

Sub Macro1()

    For a = 1 To 200 Step 10
        Worksheets("Sheet1").Range("A1:A10").Copy _
            Destination:=Worksheets("Sheet2").Range("A" & a)
    Next

End Sub

答案 1 :(得分:1)

硬编码

当源范围恰好适合目标范围时

此解决方案使用工作表的代码名称,因此您可以根据需要重命名工作表,并且代码仍然有效。在VBE的属性窗口(F4)中,代码名称称为“(名称)”,而在Excel选项卡中看到的工作表名称称为“名称”。

Sub Copy10To200()
    Sheet1.Range("A1:A10").Copy Destination:=Sheet2.Range("A1:A200")
' Instead of:
'  Worksheets("Sheet1").Range("A1:A10").Copy _
      Destination:=Worksheets("Sheet2").Range("B1:B200")
End Sub

更高级的版本

如果源范围不适合恰好位于目标范围内,会发生什么情况,请参见结尾备注部分以下代码。

'*******************************************************************************
' Purpose:  Uses a one-column range of values on a worksheet to fill up
'           a larger one-column range on a second worksheet.
'*******************************************************************************
Sub SmallColumnToColumn()

  ' Declare variables.
  Const cStrSource As String = "A1:A10"
  Const cStrTarget As String = "B1:B200"
  Dim objRngSource As Range
  Dim objRngTarget As Range
  Dim lngRowsSource As Long
  Dim lngRowsTarget As Long
  Dim lngINT As Long
  Dim lngMOD As Long

  Const blnActiveWorkbook As Boolean = False

    '***************************************************************************
    ' Additional Functionality:
    '   When FALSE is assigned to the previous boolean (blnActiveWorkbook),
    '   the initial functionality is triggered i.e. it only works within
    '   the workbook where it resides (ThisWorkbook) which is noticable in the
    '   following ELSE statement where also the codenames should be changed,
    '   if necessary.
    '   On the other hand, when TRUE is assigned, the initial functionality
    '   is expanded to any ActiveWorkbook which is noticable in the following
    '   WITH statement. The values (strings) of the codenames can now be changed
    '   in the following two CONSTANT STRING variables if necessary.
    '***************************************************************************

  ' Create references to the ranges.
  If blnActiveWorkbook Then
    ' Additional Functionality
    Const cStrCodeNameSource As String = "Sheet1" ' CodeName (Sheet1)
    Const cStrCodeNameTarget As String = "Sheet2" ' CodeName (Sheet2)
    With ActiveWorkbook
      On Error GoTo WorksheetSourceHandler
      Set objRngSource = .Worksheets(CStr(.VBProject.VBComponents _
          (cStrCodeNameSource).Properties(7))).Range(cStrSource) 'CodeName
      On Error GoTo WorksheetTargetHandler
      Set objRngTarget = .Worksheets(CStr(.VBProject.VBComponents _
          (cStrCodeNameTarget).Properties(7))).Range(cStrTarget) 'CodeName
    End With
   Else
    ' Initial Functionality
    Set objRngSource = Sheet1.Range(cStrSource) 'CodeName Sheet1
    Set objRngTarget = Sheet2.Range(cStrTarget) 'CodeName Sheet2
    ' No error handling needed, because if one of the worksheets doesn't exist,
    ' the following error occurs: "Compile error: Variable not defined"
  End If

  ' Assign the number of rows in the ranges to variables.
  lngRowsSource = objRngSource.Rows.Count
  lngRowsTarget = objRngTarget.Rows.Count

  ' Check if the first range has more rows then the second one.
  ' This ensures that lngINT (later in the code) is greater than 0.
  If lngRowsSource > lngRowsTarget Then GoTo RowsHandler

  ' DEL the target column (ClearContents).
'  objRngTarget.EntireColumn.ClearContents
'  Range(objRngTarget.Resize(Rows.Count, 1).Address).ClearContents 'HaHaHa...

  ' Check if accidentally a multiple-columns range was specified. If so, resize
  ' the range to first-column-only.
  Set objRngSource = objRngSource.Resize(lngRowsSource, 1)
  Set objRngTarget = objRngTarget.Resize(lngRowsTarget, 1)

  ' Calculate INT and MOD
  lngINT = Int(lngRowsTarget / lngRowsSource)
  lngMOD = lngRowsTarget Mod lngRowsSource

  ' Copy/paste range INT times.
  objRngSource.Copy Destination:=objRngTarget.Resize(lngINT * lngRowsSource, 1)

  ' Additionally copy/paste the first MOD number of rows.
  If lngMOD > 0 Then
    objRngSource.Resize(lngMOD, 1).Copy Destination:= _
        objRngTarget.Offset(lngINT * lngRowsSource, 0).Resize(lngMOD, 1)
  End If

ProcedureExit:

  ' Release object variables.
  Set objRngSource = Nothing
  Set objRngTarget = Nothing

Exit Sub

' Handle errors.

RowsHandler:
  MsgBox "The source range (" & lngRowsSource & ") has to have fewer rows" _
      & " than the target range (" & lngRowsTarget & ")."
  GoTo ProcedureExit

WorksheetSourceHandler:
  Select Case Err.Number
    Case 9
      MsgBox "There is no sheet with the CodeName '" & cStrCodeNameSource _
          & "' to read from. Change the value in " _
          & "'Const cStrCodeNameSource As String ='"
    Case 1004
      MsgBox "The range '" & cStrSource & "' is not a valid range." _
          & " Change the value in " _
          & "'Const cStrSource As String = '"
    Case Else
    MsgBox "An unexpected error has occured. Error '" & Err.Number & "'"
  End Select
  GoTo ProcedureExit

WorksheetTargetHandler:
  Select Case Err.Number
    Case 9
      MsgBox "There is no sheet with the CodeName '" & cStrCodeNameTarget _
          & "' to write to. Change the value in " _
          & "'Const cStrCodeNameTarget As String ='"
    Case 1004
      MsgBox "The range '" & cStrTarget & "' is not a valid range." _
          & " Change the value in " _
          & "'Const cStrTarget As String = '"
    Case Else
      MsgBox "An unexpected error has occured. Error '" & Err.Number & "'"
  End Select
  GoTo ProcedureExit

End Sub
'*******************************************************************************
' Remarks:
'   The Copy Method
'     When using Destination with the Copy Method and the target range is bigger
'     than the source range, the method atempts to fill the target range with
'     the source range and it succeeds, if the source range fits EXACTLY ANY
'     number of times into the target range. If it doesn't fit it pastes the
'     source range ONLY ONCE, into the BEGINNING of the target range.
'     In this code this issue is a little simplified due to the fact that it is
'     using only one-colum ranges. The issue is resolved by using the INT
'     function to calculate the amount of times the source range fits into
'     the target range and by pasting it as many times, and additionally by
'     using the MOD function to calculate the remainder of rows (if any) which
'     is then used to copy the first rows of the source range to fill up the
'     rest of the target range.
'*******************************************************************************