Question

EDIT 2/10/18-22:45

我说得太早了，并且更新了我的第一篇文章。虽然我认为这个问题已基本解决，但我现在看到目标是从Objectives Entry Sheet复制并粘贴在Data Validation表的每个部分（秋季，春季和夏季）中，无论在何处它们被输入到Data Validation Sheet中。

例如，如果我在F13中输入文本-“秋季，第1年，目标1”单元格，请按update键将文本复制到“数据验证”表中的单元格D19，J19和P19中-“第1年秋季，春季和春季”夏季目标1'细胞

任何人都可以建议是什么原因造成的吗？

Option Explicit

Sub SubjectObjectives()
    Dim srcWs As Worksheet
    Dim trgWs As Worksheet
    Dim dvCell As Range
    Dim AutSrc As Range, SprSrc As Range, SumSrc As Range
    Dim Art As Range, Computing As Range, DT As Range, Geography As Range, History As Range, MFL As Range, Music As Range, PE As Range, RE As Range, Science As Range
    Dim AutTarget As Range, SprTarget As Range, SumTarget As Range
    Dim cell As Range
    Dim hLink As Hyperlink

'Set source and target worksheets
    Set srcWs = Worksheets("Objectives Entry Sheet")
    Set trgWs = Worksheets("Data Validation")

'Set cell where Dropdown list is
    Set dvCell = Worksheets("Objectives Entry Sheet").Range("B11")

'Set where objectives are copied from
    Set AutSrc = srcWs.Range("F13:K18")
    Set SprSrc = srcWs.Range("F23:K28")
    Set SumSrc = srcWs.Range("F33:K38")

'Set where objectives are copied to

    If dvCell = "" Then GoTo Whoops

    If dvCell.Value = "Art" Then Set AutTarget = trgWs.Range("D19:U24")
    If dvCell.Value = "Art" Then Set SprTarget = trgWs.Range("J19:O24")
    If dvCell.Value = "Art" Then Set SumTarget = trgWs.Range("P19:U24")

    If dvCell.Value = "Computing" Then Set AutTarget = trgWs.Range("D25:U30")
    If dvCell.Value = "Computing" Then Set SprTarget = trgWs.Range("J25:O30")
    If dvCell.Value = "Computing" Then Set SumTarget = trgWs.Range("P25:U30")

    If dvCell.Value = "DT" Then Set AutTarget = trgWs.Range("D31:U36")
    If dvCell.Value = "DT" Then Set SprTarget = trgWs.Range("J31:O36")
    If dvCell.Value = "DT" Then Set SumTarget = trgWs.Range("P31:U36")

    If dvCell.Value = "Geography" Then Set AutTarget = trgWs.Range("D37:U42")
    If dvCell.Value = "Geography" Then Set SprTarget = trgWs.Range("J37:O42")
    If dvCell.Value = "Geography" Then Set SumTarget = trgWs.Range("P37:U42")

    If dvCell.Value = "History" Then Set AutTarget = trgWs.Range("D43:U48")
    If dvCell.Value = "History" Then Set SprTarget = trgWs.Range("J43:O48")
    If dvCell.Value = "History" Then Set SumTarget = trgWs.Range("P43:U48")

    If dvCell.Value = "MFL" Then Set AutTarget = trgWs.Range("D49:U54")
    If dvCell.Value = "MFL" Then Set SprTarget = trgWs.Range("J49:O54")
    If dvCell.Value = "MFL" Then Set SumTarget = trgWs.Range("P49:U54")

    If dvCell.Value = "Music" Then Set AutTarget = trgWs.Range("D55:U60")
    If dvCell.Value = "Music" Then Set SprTarget = trgWs.Range("J55:O60")
    If dvCell.Value = "Music" Then Set SumTarget = trgWs.Range("P55:U60")

    If dvCell.Value = "PE" Then Set AutTarget = trgWs.Range("D61:U66")
    If dvCell.Value = "PE" Then Set SprTarget = trgWs.Range("J61:O66")
    If dvCell.Value = "PE" Then Set SumTarget = trgWs.Range("P61:U66")

    If dvCell.Value = "RE" Then Set AutTarget = trgWs.Range("D67:U72")
    If dvCell.Value = "RE" Then Set SprTarget = trgWs.Range("J67:O72")
    If dvCell.Value = "RE" Then Set SumTarget = trgWs.Range("P67:U72")

    If dvCell.Value = "Science" Then Set AutTarget = trgWs.Range("D73:U78")
    If dvCell.Value = "Science" Then Set SprTarget = trgWs.Range("J73:O78")
    If dvCell.Value = "Science" Then Set SumTarget = trgWs.Range("P73:U78")

    Application.ScreenUpdating = False

       'Copy cell contents

            AutSrc.Copy
            AutTarget.PasteSpecial xlValues, skipblanks:=True
            AutSrc.ClearContents

            SprSrc.Copy
            SprTarget.PasteSpecial xlValues, skipblanks:=True
            SprSrc.ClearContents

            SumSrc.Copy
            SumTarget.PasteSpecial xlValues, skipblanks:=True
            SumSrc.ClearContents


    Application.CutCopyMode = False

    Application.ScreenUpdating = True

Exit Sub

Whoops:
    MsgBox "Please select a subject from the dropdown menu and press 'Update' again."

End Sub

我希望用户能够从目标条目表上的下拉列表中选择要为其输入目标的主题，并将目标输入到秋季的部分或全部单元格中，“春季和夏季学期”部分，然后单击“ 更新”按钮，将这些目标复制到数据验证表上的相应单元格区域（基于主题和学期）。< / p>

此外，还有一种方法可以指定在将单元格内容复制到“数据验证表”时保留在“目标条目表”中创建的所有超链接，因为这些单元格将用于填充其他工作表。

该文件可用here。

任何人都可以帮忙吗？

Answer 1

您的每个循环都无法正常工作。

您的代码实际执行的操作是将整个“目标”值插入autSrc范围，据我所知应该相反。

其次，它确实插入了空白单元格。

我不是向导，但我会做这样的事情：

nRows = autSrc.rows.count

nCols = autSrc.columns.count

for i = 1 to nrows
    for k = 1 to nCols
        if autSrc.cells(i,k) <> "" then

            target.cells(i,k) = autSrc.cells(i,k)            

        end if
    next k
next i

编辑：此外，我只想指出，就我所知，您的代码并未考虑不同的季节。

返回无答案-根据下拉列表中的选择复制并粘贴到特定范围的单元格

1 个答案: