宏/代码根据条件复制和转置粘贴

Question

今天是个好日子。

我目前遇到的障碍是要为作业创建的excel文件。

在我的文件中，我需要将“输入”工作表中的单元格C6:C13换位粘贴到Database表行C8:J8 or C9:J9 or C10:J10等中，基于：“输入”中单元格C5的内容工作表应与B列中的任一行匹配。

您可以在以下位置找到文件： http : //tinyurl.com/oz7w97g

提前致谢！！！

编辑2：现在我的问题是，它将数据粘贴到“数据库”表中选择的任何单元格中。 例如，如果选择了J13，它将自动将数据粘贴到J13：Q13中，而无需搜索正确的单元格。

编辑3：我想通了，将“按字符串”更改为“按日期”，它可以工作。 为了提高效率，有没有一种方法可以减少这段代码的长度，因为请记住，它需要引用72个不同的行，因此我需要键入72次“ If”和“ ElseIf”。

Sub Code1()

Dim strCriteria As Date

strCriteria = Cells(5, "C").Value

Range("C6:C13").Select
Selection.Copy
Sheets("Database").Select

If strCriteria = "01-01-2015" Then
    Range("C7").Select
ElseIf strCriteria = "01-01-2016" Then
    Range("C8").Select
ElseIf strCriteria = "01-01-2017" Then
    Range("C9").Select
End If



Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
Sheets("Input").Select
Range("D13").Select
Application.CutCopyMode = False
Range("C13").Select

结束子

Answer 1

好。 我看到您的更改。 您可以做的一件事是根据单元格C5的条件查找目标单元格。 我在单元格C4中创建了一个VLOOKUP，它将根据单元格C5中的日期查找目的地。

单元格C4中的公式为： =VLOOKUP(C5,F5:G7,2,FALSE) 。 该表在单元格F5中具有2015年1月1日，在单元格G5中具有“ C7”。 其他日期和单元格将紧随其后。

您可以根据需要在另一张纸上创建查找表。

这是新代码，然后使用单元格C4中的查找值：

Sub Code1()

    Dim strCell As String

    strCell = Cells(4, "C").Value

    Range("C6:C13").Select
    Selection.Copy
    Sheets("Database").Select

    Range(strCell).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Input").Select
    Range("D13").Select
    Application.CutCopyMode = False
    Range("C13").Select

End Sub