Question

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

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)

如您所见，此代码正在复制输入单元格的范围，数据将转移到另一个工作表中的特定输出单元格。请大家帮帮我吧！：）

Answer 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

Answer 2

尝试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", _
    "")

如何为VBA中的单元格编写模块化复制子程序？

2 个答案: