如何从UserForm一次添加多个数据行到Excel DataBase

时间:2015-11-10 10:03:42

标签: arrays excel vba excel-vba userform

我制作某种足球数据库,我会使用userform输入数据,以及从excel数据库中检索数据的位置。

我有一张名为:" wedstrijden"此工作表包含以下列:Date,HomeTeam,AwayTeam,HomeScore,AwayScore,HomeOdds和AwayOdds

我的其他工作表名为:" ingevenuitslagen"此工作表包含名为UitslagenIngeven

的用户表单

使用下面的代码,我可以将用户表单中的数据输入到我的" wedstrijden"工作表

Private Sub putAway_Click()
Dim ingevenuitslagen As Worksheet
Set ingevenuitslagen = ThisWorkbook.Sheets("wedstrijden")
NextRow = ingevenuitslagen.Cells(Rows.Count, 1).End(xlUp).Row + 1
ingevenuitslagen.Cells(NextRow, 1) = CDate(date_txt.Text)
ingevenuitslagen.Cells(NextRow, 2) = UitslagenIngeven.cboHomeTeam
ingevenuitslagen.Cells(NextRow, 3) = UitslagenIngeven.cboAwayTeam
ingevenuitslagen.Cells(NextRow, 4) = UitslagenIngeven.cboHScore
ingevenuitslagen.Cells(NextRow, 5) = UitslagenIngeven.cboAScore
ingevenuitslagen.Cells(NextRow, 6) = Val(UitslagenIngeven.hodds_txt.Text)
ingevenuitslagen.Cells(NextRow, 7) = Val(UitslagenIngeven.aodds_txt.Text)
End Sub

但这只是收起一排。我想有可能一次放掉10或15行。所以我会创建一个userform,可以放掉20行但是它应该只能放弃那些填充的行。

这可能吗?我应该如何调整我的用户形态?我可以只复制文本和组合框区域吗?

2 个答案:

答案 0 :(得分:2)

如何使用数据阵列

您需要创建一个新按钮,您将拥有:

  1. 一个用于将数据集添加到数据集(此处为CommandButton1)和
  2. 一个将数据数组添加到数据库(此处为CommandButton2)。
  3. 我也更喜欢使用数据库的命名范围,这里称为Db_Val,但您可以重命名以满足您的需求! ;)

    放置在UserForm中以填充数据数组的代码:

    Public ingevenuitslagen As Worksheet
    Public DataA() '----These lines should be at the top of the module
    
    '----Code to Set the dimension of the Data array
    Private Sub UserForm_Initialize()
        Dim DataA(7, 0)
        Set ingevenuitslagen = ThisWorkbook.Sheets("wedstrijden")
        '----Rest of your code
    End Sub
    
    '----Code to add a data set to the data array
    Private Sub CommandButton1_Click()
        UnFilter_DB '----See below procedure
    
        DataA(1) = CDate(date_txt.Text)
        DataA(2) = UitslagenIngeven.cboHomeTeam
        DataA(3) = UitslagenIngeven.cboAwayTeam
        DataA(4) = UitslagenIngeven.cboHScore
        DataA(5) = UitslagenIngeven.cboAScore
        DataA(6) = Val(UitslagenIngeven.hodds_txt.Text)
        DataA(7) = Val(UitslagenIngeven.aodds_txt.Text)
    
        ReDim Preserve DataA(LBound(DataA, 1) To UBound(DataA, 1), LBound(DataA, 2) To UBound(DataA, 2) + 1)
    End Sub
    
    '----Code to sent the data array to the DB
    Private Sub CommandButton2_Click()
        ReDim Preserve DataA(LBound(DataA, 1) To UBound(DataA, 1), LBound(DataA, 2) To UBound(DataA, 2) - 1)
    
        SetData DataA
    End Sub
    

    在数据库中打印从用户表单传递的数据数组的过程:

    此处数据库是Db_Val

    中的命名范围ingevenuitslagen
    Public Sub SetData(ByVal Data_Array As Variant)
    Dim DestRg As Range, _
        A()
    '----Find the last row of your DataBase
    Set DestRg = ingevenuitslagen.Range("Db_Val").Cells(ingevenuitslagen.Range("Db_Val").Rows.Count, 1)
    '----Print your array starting on the next row
    DestRg.Offset(1, 0).Resize(UBound(Data_Array, 1), UBound(Data_Array, 2)).Value = Data_Array
    End Sub
    

    Sub,以便对您正在使用的数据库进行不过滤:

    Public Sub UnFilter_DB()
    '----Use before "print" array in sheet to unfilter DB to avoid problems (always writing on the same row if it is still filtered)
    Dim ActiveS As String, CurrScreenUpdate As Boolean
    CurrScreenUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    ActiveS = ActiveSheet.Name
        ingevenuitslagen.Activate
        ingevenuitslagen.Range("A1").Activate
        ingevenuitslagen.ShowAllData
        DoEvents
        Sheets(ActiveS).Activate
    Application.ScreenUpdating = CurrScreenUpdate
    End Sub
    

答案 1 :(得分:0)

美好的一天。

我有同样的挑战。我的是能够下达客户的订单。根据我的代码,我每次只能为客户放置一个产品。我希望能够在Userform中同时为每个订单放置多个产品,并且它将更新多行。以下代码只能为一位客户连续更新一行产品:

Private Sub cmdAdd_Click()
Dim lRow As Long
Dim ws As Worksheet
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
    .Cells(lRow, 1).Value = Me.Data1.Value
    .Cells(lRow, 2).Value = Me.Data2.Value
    .Cells(lRow, 3).Value = Me.Data3.Value
    .Cells(lRow, 4).Value = Me.Data4.Value
    .Cells(lRow, 5).Value = Me.Data5.Value
    .Cells(lRow, 6).Value = Me.Data6.Value
    .Cells(lRow, 7).Value = Me.Data7.Value
    .Cells(lRow, 8).Value = Me.Data8.Value
    .Cells(lRow, 9).Value = Me.Data9.Value
    .Cells(lRow, 10).Value = Me.Data10.Value  
End With
End Sub

以上只能为每位客户更新一件产品。客户可以订购多种产品。