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

このコードを試してください。連続した範囲を連続していない範囲との間で貼り付けたり、その逆を行ったりすることができます。おそらく、2 つの同じサイズの連続した範囲であるかどうかを検出するのに十分なほどスマートになるように拡張して、不必要にループしないようにすることもできます。

また、読みやすくするためにコードを書き直しました。

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範囲がOKであれば、次のようなものです-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

サブルーチンを呼び出すステートメントを変更すると機能しますが、意図したとおりではない可能性があります。

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