首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >如何从用户窗体中的两个不同工作簿中捕获数据到指定的excel工作表(第一个工作簿)?

如何从用户窗体中的两个不同工作簿中捕获数据到指定的excel工作表(第一个工作簿)?
EN

Stack Overflow用户
提问于 2018-09-01 21:53:51
回答 2查看 92关注 0票数 0

我有一个workbook-1,当点击add按钮时,应该从用户表单中实际捕获数据。

在workbook-2中,我只有我的组合框列表,以便在用户表单中自动从组合框和文本框中选择时显示excel数据。

但现在我面临一个问题,当我通过选择所有组合框列表并手动填充其他数据来填写用户表单时,然后单击添加按钮,数据将转移到我的工作簿-2(在我的组合框列表下面)。

如何将用户表单数据捕获到我的工作簿-1\f25 Sheetname -1\f25 "Sheet1“-1上。

我的-2\f25 Workbook-2 \f6路径是-2\f25“C:\Users\Desktop\Work.xlmx-2\f6”-2\f6,命令按钮也需要包括这个路径吗?

下面是我的combox和add命令按钮的代码:

代码语言:javascript
复制
Private Sub cboLs_DropButtonClick()

Dim wb As Workbook   'workbook 2 for combobox list 
Dim i As Long
Dim ssheet As Worksheet

Set wb = Workbooks.Open("C:\Users\Desktop\Book1.xlsx")
Set ssheet = wb.Worksheets("LS")

If Me.cboLs.ListCount = 0 Then
    For i = 2 To ssheet.Range("A" & ssheet.Rows.Count).End(xlUp).Row
        Me.cboLs.AddItem Sheets("LS").Cells(i, "A").Value
    Next i
End If
End Sub

Private Sub cboLs_Change()

Dim wb As Workbook
Dim ssheet As Worksheet
Dim i As Long

Set wb = Workbooks.Open("C:\Users\Desktop\Book1.xlsx")
Set ssheet = wb.Worksheets("LS")

For i = 2 To ssheet.Range("A" & ssheet.Rows.Count).End(xlUp).Row
    If ssheet.Cells(i, "A").Value = (Me.cboLs) Or ssheet.Cells(i, "A").Value = Val(Me.cboLs) Then
        Me.txtProject = ssheet.Cells(i, "B").Value
    End If
Next i
End Sub


Private Sub cmdadd_Click()
Dim e As Long
Dim Sheet1 As String

Worksheets(Sheet1).Activate  'Workbook-1 here i need to capture my userform data but it is going to workbook-2 on sheetname LS

    'position cursor in the correct cell A6.
    ActiveSheet.Range("A6").Select

    e = 1 'set as the first ID

    'if all the above are false (OK) then carry on.
    'check to see the next available blank row start at cell A6...
    Do Until ActiveCell.Value = Empty
        ActiveCell.Offset(1, 0).Select 'move down 1 row
        e = e + 1 'keep a count of the ID for later use
    Loop

    'Populate the new data values into the 'Data' worksheet.
    ActiveCell.Value = e 'Next ID number
    ActiveCell.Offset(0, 2).Value = Me.txtname.Text 'set col B
    ActiveCell.Offset(0, 3).Value = Me.txtbook.Text 'set col C
    ActiveCell.Offset(0, 1).Value = Me.cboLs.Text 'set col D

    Me.txtname.Text = Empty
    Me.txtbook.Text = Empty
    Me.cboLs.Text = Empty

End Sub
EN

回答 2

Stack Overflow用户

发布于 2018-09-02 00:22:42

在您的代码中,我从未看到您设置Sheet1字符串变量的值。

请注意,不需要激活工作表即可使用它。同样,不需要选择单元格。试试这样的..。

代码语言:javascript
复制
Private Sub cmdadd_Click()
Dim e As Long   
Dim destSheet As Worksheet
Set destSheet = Worksheets("Sheet1")

ActiveSheet.Range("A6").Select
    e = 1 'set as the first ID

    'if all the above are false (OK) then carry on.
    'check to see the next available blank row start at cell A6...
    Do Until ActiveCell.Value = Empty
        ActiveCell.Offset(1, 0).Select 'move down 1 row
        e = e + 1 'keep a count of the ID for later use
    Loop

    'Populate the new data values into the 'Data' worksheet.
    destSheet.Range("A6").Value = e 'Next ID number
    destSheet.Range("B6").Value = Me.txtname.Text 'set col B
    destSheet.Range("C6").Value = Me.txtbook.Text 'set col C
    destSheet.Range("D6").Value = Me.cboLs.Text 'set col D

    Me.txtname.Text = Empty
    Me.txtbook.Text = Empty
    Me.cboLs.Text = Empty

End Sub

同样,对您的循环使用相同的方法来获得所需的e值。顺便说一句,如果您只是查找列A中最后填充的行的值,而不是循环(循环效率很低),那么您可以使用

代码语言:javascript
复制
destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Value

这等同于转到列A底部的最后一个单元格,然后按CTRL+Up键转到最后填充的单元格。然后你可以在这个值上加1。

票数 0
EN

Stack Overflow用户

发布于 2018-09-02 00:33:26

在子cmdadd_Click中,第二个工作簿仍处于活动状态。因此,在工作表(‘Sheet1’).Activate之前添加:

代码语言:javascript
复制
Dim wb As Workbook
Dim ssheet As Worksheet

Set wb = Workbooks.Open("C:\Users\Desktop\Work.xlmx")
Set ssheet = wb.Worksheets("Sheet1")

就像你在其他潜水艇上做的那样。接下来,在工作表(‘sheet1’)前添加以下内容:

代码语言:javascript
复制
wb.activate
ssheet.activate

从您的sub中删除以下行:

代码语言:javascript
复制
Dim Sheet1 As String
Worksheets(Sheet1).Activate  

这应该能起到作用。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/52128764

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档