Question

我在Excel上制作电影数据库，我已经把它全部搞定了。它的工作正常，我决定添加一个数据输入表单，允许用户在表单中输入电影详细信息，并自动使用宏，然后将这些数据移动到一个单独的工作表与我的所有电影。我已设法记录所有这一步，它工作正常，但它覆盖数据，只使用我粘贴它的行'A47'。我现在想知道如何编辑代码，以便如果此行中已有数据，它将更改为下一行。另外需要注意的是，我的宏也会格式化该选择，因此也需要更改。格式化基本上将某些单元格更改为粗体和文本对齐方式。我将附上代码，以便您可以看到我在说什么。此外，最后的代码删除了数据输入表单中的数据，因此它可以用于另一个条目。

对不起，我对这一切都很陌生，我环顾四周，但没有人像我一样有问题。

任何帮助都将不胜感激。

由于

Sub SubmitMovie()
'
' SubmitMovie Macro
'

'
    Range("K9,K11,K13,K15,K17,K19,K21").Select
    Range("K21").Activate
    Selection.Copy
    Sheets("MovieList").Select
    Range("A74:G74").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B74").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("D74").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A74:G74").Select
    Range("G74").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Sheets("Add New Movie").Select
    Range("K9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("K11").Select
    ActiveCell.FormulaR1C1 = ""
    Range("K13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("K15").Select
    ActiveCell.FormulaR1C1 = ""
    Range("K17").Select
    ActiveCell.FormulaR1C1 = ""
    Range("K19").Select
    ActiveCell.FormulaR1C1 = ""
    Range("K21").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D28").Select
End Sub

Answer 1

替换此

Range("K9,K11,K13,K15,K17,K19,K21").Select
Range("K21").Activate
Selection.Copy
Sheets("MovieList").Select
Range("A74:G74").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

与

Dim dest as Range

Activesheet.Range("K9,K11,K13,K15,K17,K19,K21").Copy

'find the first non-empty cell in ColA (from bottom up)    
Set dest = Sheets("MovieList").Cells(rows.count,1).End(xlUp).offset(1,0)

dest.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
      SkipBlanks:= False, Transpose:=True

Answer 2

欢迎来到SO。

由于您是VBA的新手，您已经选择了一种通过使用宏录制器开始学习更多知识的好方法，但您已经了解到它有其局限性。它并不总是以最有效的方式做事。

关于如何改进脚本的一些指示：

删除所有不知道其功能的代码。大多数应该是自我解释的，但如果你不知道它做了什么，你可能不需要它，因为宏录音机增加了许多不必要的东西。
避免使用Select导航工作表。效率非常低，会降低代码速度：有关如何avoid using select的提示。
SO上有lots of questions关于查找上次使用的行以了解可以保存新数据的位置。
使用每个代码模块顶部的Option Explicit来最大限度地减少由拼写错误等引起的混淆和错误。它将强制您显式声明所有使用的变量，这是一件好事，因为VBA否则会接受所有变量名称如果之前尚未声明，则为新变体类型。
如果您遇到特定问题 - 请询问有关该特定问题的问题。

Answer 3

上一篇文章应该可以帮助您了解解决方案中涉及的一些概念/语法：Loops & Rows

最重要的是你遇到了一个问题，宏录制器无法让你离开。在VBA中花些时间学习循环，计数和Cells（）函数对你来说真的很有用。 Olle和Tim是最受欢迎的...特别是Tim的“Set dest =”系列。

此链接显示了循环语法的一个很好的示例，可能对未来类似性质的问题有所帮助：

Looping Through Ranges

如何对此宏进行排序，以便自动选择下一行

3 个答案: