VBA将数据传输到另一个工作簿

VBA将数据从一张纸传输到另一张

在附图中,这是最终目标。

我想使用VBA将数据从一张纸传送到另一张纸上。 到目前为止,当我点击“Submit”时,Country,Name,Surname的数据将被正确地发送到名为“data”的表单中。 但是,我不确定如何在名为“data”的工作表中填充“Race”字段。 我明白,我应该使用if语句,但我不知道如何将其纳入VBA代码。

这是目前的vba代码。

Private Sub CommandButton1_Click() Dim Country As String, Name As String, Surname As String, Race As String Worksheets("form").Select Country = Range("B4") Name = Range("B6") Surname = Range("B7") Race = Range("B13") Worksheets("data").Select Worksheets("data").Range("A1").Select If Worksheets("data").Range("A1").Offset(1, 0) <> "" Then Worksheets("data").Range("A1").End(xlDown).Select End If ActiveCell.Offset(1, 0).Select ActiveCell.Value = Country ActiveCell.Offset(0, 1).Select ActiveCell.Value = Name ActiveCell.Offset(0, 1).Select ActiveCell.Value = Surname ActiveCell.Offset(0, 1).Select ActiveCell.Value = Race Worksheets("form").Select Worksheets("form").Range("A4").Select End Sub 

我是VBA新手,对此事的任何帮助将不胜感激。

这是给你的东西,但是我对你有一些批评

1)select/激活/复制/粘贴都是坏习惯。 你最终会写很多毫无意义的代码来获得任何用处,而且你放慢了整个程序。 这很重要,如果有很多东西你正在互动。

2)。 表单选项卡上的种族看起来是合并的单元格。 我在这里的代码片段正在假设种族事实上是单元格b13,c13和d13。 合并的单元格很烦人,可能是你的问题的根源。 或者我可能是完全错误的,你真的是超级新的。 无论哪种方式你学习的东西。

 Private Sub CommandButton1_Click() Dim Country As String, Name As String, Surname As String, Race As String dim ws as worksheet, wb as workbook, ws1 as worksheet set wb = ThisWorkbook set ws = wb.Sheets("form") set ws1 = wb.Sheets("data") Country = ws.Range("B4").value Name = ws.Range("B6").value Surname = ws.Range("B7").value If ws.Range("B13").Value <> "" Then Race = "White" If ws.Range("C13").Value <> "" Then Race = "Black" If ws.Range("D13").Value <> "" Then Race = "Asian" ws1.Cells(ws1.Rows.Count,1).End(xlUp).Offset(1,0).Value = Country ws1.Cells(ws1.Rows.Count,1).End(xlUp).Offset(0,1).Value = Name ws1.Cells(ws1.Rows.Count,1).End(xlUp).Offset(0,2).Value = Surname ws1.Cells(ws1.Rows.Count,1).End(xlUp).Offset(0,3).Value = Race End Sub 

我其实有点像这样更好,更less的变数。 而不是使用无意义的variables来存储值,你可以将这些值存储在一个数组中,并将它们一次全部移动,这也是我的想法。 当然,我知道我使用相同数量的fovariables来制作工作表/工作簿对象,但是你可以把它们写出来(我实际上更喜欢这样做,即使它的文本在这一点上)。

我还包括一些检查,以防万一select了一个以上的比赛,或根本没有。

 Private Sub here() Dim ws As Worksheet, wb As Workbook, ws1 As Worksheet Dim arr(0, 4) As String Set wb = ThisWorkbook Set ws = wb.Sheets("Sheet1") Set ws1 = wb.Sheets("Sheet2") arr(0, 0) = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Value + 1 arr(0, 1) = ws.Range("B4").Value arr(0, 2) = ws.Range("B6").Value arr(0, 3) = ws.Range("B7").Value If (ws.Range("B13").Value <> "" And ws.Range("C13").Value <> "") _ Or (ws.Range("B13").Value <> "" And ws.Range("D13").Value <> "") _ Or (ws.Range("D13").Value <> "" And ws.Range("C13").Value <> "") Then arr(0, 4) = "Mixed Race" Else arr(0, 4) = IIf(ws.Range("B13").Value <> "", "White", _ IIf(ws.Range("C13").Value <> "", "Black", _ IIf(ws.Range("D13").Value <> "", "Asian", "Must Be Non-Human"))) End If ws1.Range(ws1.Cells(ws1.UsedRange.Rows.Count + 1, 1), _ ws1.Cells(ws1.UsedRange.Rows.Count + 1, 5)).Value2 = arr End Sub