如何将基于多个单元格条件的值复制到另一个工作表

Question

我在“表单”工作表中有一个输入范围（F9：F58），我需要基于“表单”工作表中的多个条件（E2）和（E6）将这些输入值复制到另一个工作表“基于数据的数据”中的表中”。 注意：输入值的条件目标表在特定列中。

Public Sub InputUnload()

    Set copysheet = Sheets("Form")
    Set pasteSheet = Sheets("Databased")

    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = _
    copysheet.Range("E2").Value
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = _
    copysheet.Range("E6").Value

    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) _
            .PasteSpecial xlPasteValues, Transpose:=True _
            = copysheet.Range("F9:F58").Value

End Sub

"Form" Sheet

"Databased" sheet

谢谢。

Answer 1

移调范围

在pasteSheet中，在处理的列之前和之间有数据。如果您不打算将这些列添加到此代码中，并且在处理列时未计算这些列，则应将每个'，1'（计算列1（“ A”）中的最后一行）更改为适当的列数字或代码将始终粘贴在同一行中。在这种情况下，处理的第一列是列3（C）。

快速更新

Sub InputUnload()

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim vntRange As Variant
    Dim lastRow As Long

    Set copySheet = Sheets("Form")
    Set pasteSheet = Sheets("Databased")

    ' Calculate last row of data.
    lastRow = pasteSheet.Cells(Rows.Count, 1).End(xlUp).Row

    ' Copy 2 cells.
    pasteSheet.Cells(lastRow + 1, 1).Offset(0, 2) = copySheet.Range("E2").Value
    pasteSheet.Cells(lastRow + 1, 1).Offset(0, 4) = copySheet.Range("E6").Value

    ' Paste column range into array.
    vntRange = copySheet.Range("F9:F58").Value

    ' Paste transpose array into row range.
    pasteSheet.Cells(lastRow + 1, 1).Offset(0, 5).Resize(, copySheet _
            .Range("F9:F58").Rows.Count).Value = Application.Transpose(vntRange)

End Sub

改进版本

在代码的开头，您有许多应该在常量中的值，因此您可以快速更改它们。在以下代码中，出于快速更新版本中先前提到的原因，适当调整列cVntLastRowColumn。

Sub InputUnload()

    ' Source
    Const cStrSource As Variant = "Form"        ' Source Worksheet Name/Index
    Const cStrDate As String = "E2"             ' Date Cell Range Address
    Const cStrSalesman = "E6"                   ' Salesman Cell Range Address
    Const cStrRange = "F9:F58"                  ' Source Column Range Address
    ' Target
    Const cStrTarget As Variant = "Databased"   ' Target Worksheet Name/Index
    Const cVntLastRowColumn As Variant = 1      ' Last Row Column Letter/Number
    Const cVntDateColumn As Variant = 3         ' Date Column Letter/Number
    Const cVntSalesmanColumn As Variant = 5     ' Salesman Column Letter/Number
    Const cVntFirstColumn As Variant = 6        ' First Column Letter/Number

    Dim objSource As Worksheet   ' Source Worksheet
    Dim objTarget As Worksheet   ' Target Worksheet
    Dim vntRange As Variant      ' Source Range Array
    Dim lngLastRow As Long       ' Target Last Row Number

    Set objSource = Sheets(cStrSource)  ' Create reference to Source Worksheet.
    Set objTarget = Sheets(cStrTarget)  ' Create reference to Target Worksheet.

    ' Calculate Target Last Row Number in Target Worksheet.
    lngLastRow = objTarget.Cells(Rows.Count, cVntLastRowColumn).End(xlUp).Row

    ' Copy Date Cell Range value to Target Worksheet.
    objTarget.Cells(lngLastRow + 1, cVntDateColumn) _
            = objSource.Range(cStrDate).Value

    ' Copy Salesman Cell Range value to Target Worksheet.
    objTarget.Cells(lngLastRow + 1, cVntSalesmanColumn) _
            = objSource.Range(cStrSalesman).Value

    ' Paste Source Column Range into Source Array.
    vntRange = objSource.Range(cStrRange).Value

    ' Paste transpose Source Array into Target Row Range
    ' starting from First Column.
    objTarget.Cells(lngLastRow + 1, cVntFirstColumn) _
            .Resize(, objSource.Range(cStrRange).Rows.Count) _
            = Application.Transpose(vntRange)

End Sub

如果“源”和“目标”的概念太混乱了，您可以通过简单地重命名“源到复制”和“目标到粘贴”的所有变量来更改所有变量。