1

我需要能够编写一个复制子例程，它将读取输入工作表名称和输入单元格，并将这些数据复制到特定的输出表和输出单元格。该子程序必须模块化，因为它将在多个工作表中使用。它只会将数据从输入表复制到输出表。这是我写的一个，但它不起作用。

Public Sub Copy_Input_Data_To_Output_Data( _
 ByVal pv_str_input_worksheet_name As String, _
 ByVal pv_str_output_worksheet_name As String, _
 ByVal pv_str_input_cell_range As String, _
 ByVal pv_str_output_cell_range As String, _
 ByRef pr_str_error_message As String)

 Worksheets(pv_str_input_worksheet_name).Range(pv_str_input_cell_range).Value  = _
 Worksheets(pv_str_output_worksheet_name).Range(pv_str_output_cell_range).Value
End Sub

这是应用于输入表的子例程的代码。

Call Copy_Input_Data_To_Output_Data( _
 pv_str_in… _
 pv_str_output_worksheet_name:="Sheet2", _
 pv_str_input_cell_range:="B13:B17", _
 pv_str_output_cell_range:=""B17,B20,B34,B18,B21", _
 pr_str_error_message:=str_error_message)

如您所见，此代码正在复制输入单元格的范围，并且数据将转到另一张表中的特定输出单元格。请帮助我会非常喜欢它！:)

4

2 回答 2

1

试试这个代码。它将连续范围粘贴到/从非连续范围粘贴，反之亦然。您可能可以将它增强到足够智能以检测它是否是两个相同大小的连续范围，因此它不会不必要地循环。

我还改写了代码以简化可读性。

Option Explicit

Sub RunIt()

Dim mySheet As Worksheet, yourSheet As Sheet1
Dim myRange As Range, yourRange As Range

Set mySheet = Sheets("mySheet")
Set yourSheet = Sheets("yourSheet")
Set myRange = mySheet.Range("A1:A3")
Set yourRange = yourSheet.Range("A6,B7,C8")

CopyCells mySheet, yourSheet, myRange, yourRange

End Sub

Sub CopyCells(wksIn As Worksheet, wksOut As Worksheet, rngIn As Range, rngOut As Range)

If rngIn.Cells.Count <> rngOut.Cells.Count Then

    MsgBox "Ranges are not equal. Please try again."
    Exit Sub

End If


Dim cel As Range, i As Integer, arrOut() As String
arrOut() = Split(rngOut.Address, ",")

i = 0

For Each cel In wksIn.Range(rngIn.Address)

    wksOut.Range(arrOut(i)).Value = cel.Value

    i = i + 1

Next

End Sub
于 2012-10-16T15:53:30.227 回答
0

试试对象的Copy方法Range。如下所示，前提是您的范围没问题 - 为了Range便于阅读，它们被复制到对象中：

Dim oRangeIn as Range
Dim oRangeOut as Range

Set oRangeIn = Worksheets(pv_str_input_worksheet_name).Range(pv_str_input_cell_range)
Set oRangeOut = Worksheets(pv_str_output_worksheet_name).Range(pv_str_output_cell_range)

oRangeIn.Copy oRangeOut

Set oRangeIn = Nothing
Set oRangeOut = Nothing

如果您更改调用 sub 的语句，它将起作用 - 但可能与预期不同：

Call Copy_Input_Data_To_Output_Data( _
    "Sheet1", _
    "Sheet2", _
    "B13:B17", _
    "B17,B20,B34,B18,B21", _
    "")
于 2012-10-16T13:37:36.780 回答