时间戳

首页 > 解决方案 > 如何将基于多个单元格条件的值复制到另一个工作表

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

问题描述

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

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

“表格”表

“数据库”表

提前致谢。

标签： excelvba

解决方案

移调范围

在 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

如果源和目标的概念过于混乱，您可以通过简单地将所有出现的 Source 重命名为 Copy 并将 Target 重命名为 Paste 来更改所有变量。

推荐阅读