如何在VBA中为单元写一个模块化复制子例程？ [英] How to write a modularized copy subroutine for cells in VBA?

问题描述

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

I need to be able to write a copy subroutine that will read in the input worksheet name and the input cells, and copy this data to a specific output sheet and output cells. This subroutine must be modularized because it will be used in mulitiple worksheets.It will only copy the data from input sheets to output sheets. Here is one I have written but it doesn't work.

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

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

Here is the code of that subroutine being applied to a input sheet.

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)

正如你所见Ť他的代码是输入单元格的复制范围，数据转到另一张表中的特定输出单元格。请帮助我大大减少它！ ：）

As you can see this code is copying ranges of input cells and the data goes to specific output cells in another sheet. Please help I would greatly appericate it! :)

推荐答案

尝试此代码。它将工作粘贴到/不连续范围的连续范围，反之亦然。你可能会增强它甚至足够聪明，以检测它是否是两个相同大小的连续范围，所以它不会不必要地循环。

Try this code out. It will work pasting a contiguous range to / from a non-contiguous range and vice versa. You could probably enhance it to even be smart enough to detect if it's two same-sized contiguous ranges, so it wouldn't loop unnecessarily.

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

I've also reworded the code to simplify readability.

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

这篇关于如何在VBA中为单元写一个模块化复制子例程？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！