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

Question

大家好日子。

我正面临着一个包含excel文件的障碍，我正在为作业创建。

在我的文件中，我需要来自工作表'输入'的单元格C6:C13在Database工作表行C8:J8 or C9:J9 or C10:J10等中进行转置粘贴，具体取决于：单元格的内容{{1 “输入”表中的“}”应该与列B中的一行匹配。

您可以在此处找到该文件：http://tinyurl.com/oz7w97g

提前致谢!!!

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

编辑3：我想通了，将'As String'改为'As Date'并且它有效。为了提高效率，有没有办法可以减少这段代码的长度，因为请记住它需要引用72个不同的行，所以我需要输入'If'和'ElseIf'72次。 / p>

C5

End Sub

Answer 1

行。我看到你的变化。您可以做的一件事是根据单元格C5的criteia查找目标单元格。我在单元格C4中创建了一个VLOOKUP，它将根据单元格C5中的日期查找目标

单元格C4中的公式为：=VLOOKUP(C5,F5:G7,2,FALSE)。表格在2015年1月1日的单元格F5和＆＃34; C7＆＃34;在单元格G5中。其他日期和单元格将直接位于其下方。

如果需要，您可以在另一张纸上创建查找表。

这是新代码，然后使用单元格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