vba 使用 Excel 中的按钮将信息从一个工作表复制到另一个新行
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/22514690/
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
Use a button in Excel to copy information from one sheet to another on a new row
提问by user3438974
I have one workbook with two sheets. Sheet 1 is laid out to look like a form with a submit button and named TravelRequest. Sheet 2 is just a database that is collected from sheet 1 and named TravelLog.
我有一本工作簿,里面有两张纸。Sheet 1 的布局看起来像一个带有提交按钮并命名为TravelRequest的表单。表 2 只是从表 1 中收集并命名为TravelLog的数据库。
Here is how it works now:
这是它现在的工作原理:
- User on Sheet 1 fills out the proper sections of the Excel form
- User clicks on the Submit button
- Data gets copied onto Sheet 2 in its own columns all in 1 row and clears Sheet 1 entries
- When the next user fills out the form it should add a new ROW in Sheet 2
- Sheet 1 上的用户填写 Excel 表单的适当部分
- 用户点击提交按钮
- 数据被复制到工作表 2 中其自己的列中的所有 1 行并清除工作表 1 条目
- 当下一个用户填写表单时,它应该在工作表 2 中添加一个新的 ROW
So, right now my script copies one cell to another specified cell and I tried many different codes from this website but cant seem to get any to work, also my copy script is hardcoded copy & paste operations. I don't know how to work around that.
所以,现在我的脚本将一个单元格复制到另一个指定的单元格,我尝试了这个网站上的许多不同代码,但似乎无法正常工作,而且我的复制脚本是硬编码的复制和粘贴操作。我不知道如何解决这个问题。
I can upload the Excel sheet somewhere if anyone needs it for helping out here.
如果有人需要它来帮助这里,我可以将 Excel 工作表上传到某个地方。
Sub Submit()
Application.ScreenUpdating = False
Range("L5").Copy
Sheets("TravelLog").Range("B6").PasteSpecial xlPasteValues
Range("C5").Copy
Sheets("TravelLog").Range("C6").PasteSpecial xlPasteValues
Range("G5").Copy
Sheets("TravelLog").Range("D6").PasteSpecial xlPasteValues
Range("c10").Copy
Sheets("TravelLog").Range("E6").PasteSpecial xlPasteValues
Range("c9").Copy
Sheets("TravelLog").Range("F6").PasteSpecial xlPasteValues
Range("I9").Copy
Sheets("TravelLog").Range("G6").PasteSpecial xlPasteValues
Range("I10").Copy
Sheets("TravelLog").Range("H6").PasteSpecial xlPasteValues
Range("C13").Copy
Sheets("TravelLog").Range("I6").PasteSpecial xlPasteValues
Range("C14").Copy
Sheets("TravelLog").Range("J6").PasteSpecial xlPasteValues
Range("C15").Copy
Sheets("TravelLog").Range("K6").PasteSpecial xlPasteValues
Range("C16").Copy
Sheets("TravelLog").Range("L6").PasteSpecial xlPasteValues
Range("C17").Copy
Sheets("TravelLog").Range("M6").PasteSpecial xlPasteValues
Range("C18").Copy
Sheets("TravelLog").Range("N6").PasteSpecial xlPasteValues
Range("i13").Copy
Sheets("TravelLog").Range("O6").PasteSpecial xlPasteValues
Range("i14").Copy
Sheets("TravelLog").Range("P6").PasteSpecial xlPasteValues
Range("i15").Copy
Sheets("TravelLog").Range("Q6").PasteSpecial xlPasteValues
Range("i16").Copy
Sheets("TravelLog").Range("R6").PasteSpecial xlPasteValues
Range("i17").Copy
Sheets("TravelLog").Range("S6").PasteSpecial xlPasteValues
Range("h20").Copy
Sheets("TravelLog").Range("W6").PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End Sub
* EDIT *
* 编辑 *
With druciferre's answer, I'm getting this error
有了 druciferre 的回答,我收到了这个错误
ERROR OVERFLOW
错误溢出
on this line
在这条线上
Worksheets("TravelLog").Range(Dest).Value = Worksheets("TravelRequest").Range(Field).Value
Here is the updated refTable
array.
这是更新后的refTable
数组。
refTable = Array("B = L5", "C = C5", "D=G5", "E=C10", "F=C9", "G=I9", "H=I10", "I=C13", "J=C14", "K=C15", "L=C16", "M=C17", "N=C18", "O=I13", "P=I14", "Q=I15", "R=I16", "S=I17", "W=H20")
采纳答案by Drew Chapin
Try this...
尝试这个...
Dim refTable As Variant, trans As Variant
refTable = Array("B = L5", "C = C5", "D=G5", "E=C10", "F=C9")
Dim Row As Long
Row = Worksheets("TravelLog").UsedRange.Rows.Count + 1
For Each trans In refTable
Dim Dest As String, Field As String
Dest = Trim(Left(trans, InStr(1, trans, "=") - 1)) & Row
Field = Trim(Right(trans, Len(trans) - InStr(1, trans, "=")))
Worksheets("TravelLog").Range(Dest).value = Worksheets("TravelRequest").Range(Field).value
Next
In the refTable
array, each item is a translation of the form field to the destination column. So, if L5
from the form is supposed to go column B
on the log, then you write B = L5
. The code can handle with the spaces or without.
在refTable
数组中,每一项都是表单字段到目标列的转换。所以,如果L5
从表单应该去B
日志上的列,那么你写B = L5
. 代码可以处理有空格或没有空格。