vba Excel：将选择移动到特定列中的下一个空白行，并按日期和类型枚举选择
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14506312/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel: Move selection to next blank row in specific column, and enumerate selection by date and type
提问by Parseltongue
New to VBA, so be gentle.
VBA 新手，所以要温柔。
I have a 7 columns, A:H. The first column is a unique numerical identifier (starts at 0 and should increase each time I paste a new selection via this macro). The second column is Date which is entered in by hand after being prompted.
我有一个 7 列，A:H。第一列是唯一的数字标识符（从 0 开始，每次通过此宏粘贴新选择时都应增加）。第二列是Date，提示后手动输入。
I want to be able to highlight a range of cells, activate the macro, and the macro move the data highlighted and paste it in next available chunk of space between the C and I columns. At the beginning, the macro prompts a dialog box asks the user for the date. I want this date to be entered at each point along Column B (in the next empty cell) for each cell in the selection.
我希望能够突出显示一系列单元格，激活宏，宏移动突出显示的数据并将其粘贴到 C 和 I 列之间的下一个可用空间块中。一开始，宏会提示一个对话框，询问用户日期。我希望在选择中的每个单元格沿 B 列（在下一个空单元格中）的每个点输入此日期。
Here are how the columns are formatted now: http://i.imgur.com/7ytAnr9.png
以下是现在如何格式化列：http: //i.imgur.com/7ytArn9.png
Then, for each cell in the selection, I want it to be associated with a numerical ID. So the script would look to see what the last number was in column A, add one to that, and paste that for each cell in the current selection.
然后，对于选择中的每个单元格，我希望它与一个数字 ID 相关联。因此，脚本将查看 A 列中的最后一个数字是什么，向其添加一个，然后将其粘贴到当前选择的每个单元格中。
Here's my code, but as I'm new to this, it's completely broken.
这是我的代码，但由于我是新手，它完全坏了。
For the DialogBox:
对于对话框：
Sub SuperMacro()
Dim c As Object
Dim dateManager As String
dateManager = InputBox(Prompt:="Enter the Date for Selection", _
Title:="Date Manager", Default:="1/24/2013")
If strName = "Your Name here" Or _
strName = vbNullString Then
Exit Sub
End If
For Each c In Selection
Range("A1").End(xlDown).Offset(1, 0).Select 'Paste the date for each cell in selection
ActiveSheet.Paste
Next c
'Attempt to move all date from selected area to next available chunk of space between C1 and H1.
Selection.Copy
Range("C1:H1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End Sub
EDIT: Figured out a solution for the ID enumeration issue and column movement:
编辑：找出 ID 枚举问题和列移动的解决方案：
Sub CopyTest()
Dim a As Range, b As Range
Dim value As Integer
Selection.Copy
Set a = Selection
Range("B1:H1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
value = (Range("A1").End(xlDown)) + 1
For Each b In a.Rows
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.value = value
Next
End Sub
Let me know if there is a more efficient way of doing this.
让我知道是否有更有效的方法来做到这一点。
FOund a solution myself, for others:
自己为其他人找到了解决方案：
Sub SuperMacro()
子超宏()
Dim a As Range, b As Range
Dim currentID As Integer
Set a = Selection
Selection.Cut Range("C1:I1").End(xlDown).Offset(1, 0) 'Pastes to appropriate column
currentID = Range("A1").End(xlDown).Value
For Each b In a.Rows
Range("A1").End(xlDown).Offset(1, 0) = currentID + 1
Range("B1").End(xlDown).Offset(1, 0) = InputBox("Enter Date", "Date Helper")
Next b
End Sub
结束子
采纳答案by Parseltongue
Here's the answer I found:
这是我找到的答案：
Dim a As Range, b As Range
Dim currentID As Integer
Set a = Selection
Selection.Cut Range("C1:I1").End(xlDown).Offset(1, 0) 'Pastes to appropriate column
currentID = Range("A1").End(xlDown).Value
For Each b In a.Rows
Range("A1").End(xlDown).Offset(1, 0) = currentID + 1
Range("B1").End(xlDown).Offset(1, 0) = InputBox("Enter Date", "Date Helper")
Next b
End Sub
