根据目标表创建辅助参考

时间:2017-08-18 11:44:10

标签: database excel vba excel-vba

我目前陷入两难境地。我这里有一个代码,可以很好地用于简单的数据输入。只需弹出信息,然后单击用户表单上的按钮,将信息发送到主表,以及根据具体的限定方面可能需要的其他3张表中的1或2个。

我在这里遇到的问题是mastersheet有一个引用,它只是序列中的下一个数字。如果输入的数据符合我对ws2的要求,那么我希望它生成另一个参考号,它也将是序列中的下一个号码(仅在该表中)。

以下是我的代码,是否有人能够帮助?

谢谢,

Dim mRow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim Nextnum As Long
Dim Xnum As Long



Set ws1 = Worksheets("MasterData")
Set ws2 = Worksheets("X")
Set ws3 = Worksheets("A")
Set ws4 = Worksheets("C")

Nextnum = Sheets("MasterData").Range("A2").End(xlDown).Value + 1
'Xnum = Sheets("X").Range("A2").End(xlDown).Value + 1


Dim TargetWorksheets As Variant
'16 qualifying scenarios to determine where the data will be sent

    Select Case True
        Case ComboPD.Value = "Y" And ComboNP.Value = "Y" And txtCVal.Value >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: TargetWorksheets = Array(ws1, ws2, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "Y" And txtCVal.Value >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws2, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "Y" And txtClaimVal.Value < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "Y" And txtCVal.Value < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And txtCVal.Value >= 50 And DateValue(Me.TD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws2, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And txtCVal.Value >= 50 And DateValue(Me.TD.Value) - DateValue(Me.TxtDD.Value) > 3: TargetWorksheets = Array(ws1, ws2, ws4)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And txtCVal.Value < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And txtCVal.Value < 50 And DateValue(Me.TD.Value) - DateValue(Me.TxtDD.Value) > 3: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And txtCVal.Value >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And txtCVal.Value >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And txtCVal.Value < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And txtCVal.Value < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And txtCVal.Value >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And txtCVal.Value >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 3: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And txtCVal.Value < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And txtCVal.Value < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws4)

        Case Else: TargetWorksheets = Array(ws1)
    End Select

For Each ws In TargetWorksheets

'find first empty row in worksheets
    mRow = ws.Cells.Find(what:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'copy userform info data to the qualifying database sheets
    ws.Cells(mRow, 1).Value = Nextnum
    ws.Cells(mRow, 2).Value = Format(Date, "DD/MM/YYYY")
    ws.Cells(mRow, 3).Value = Format(Time, "HH:MM:SS")
    ws.Cells(mRow, 4).Value = CInt(Format(Date, "WW"))
    ws.Cells(mRow, 5).Value = Format(Date, "MMM-YY")
    ws.Cells(mRow, 6).Value = CInt(Format(Date, "YYYY"))
    ws.Cells(mRow, 7).Value = 1
    ws.Cells(mRow, 8).Value = TxtWt.Value * (1300 / 1000)
    ws.Cells(mRow, 9).Value = Application.WorksheetFunction.VLookup(ComboBd.Value, Sheets("Lookup Vals").Range("G:H"), 2, False)
    ws.Cells(mRow, 10).Value = Application.UserName
               If ComboBd.Value = "Mn" Then ws.Cells(mRow, 11).Value = Application.WorksheetFunction.VLookup(ComboCompany.Value, Sheets("Lookup Vals").Range("L:N"), 2, False) Else
               If ComboBd.Value = "Pur" Then ws.Cells(mRow, 11).Value = Application.WorksheetFunction.VLookup(ComboCompany.Value, Sheets("Lookup Vals").Range("P:R"), 2, False) Else
                   If ComboBd.Value = "Vog" Then ws.Cells(mRow, 11).Value = Application.WorksheetFunction.VLookup(ComboCom.Value, Sheets("Lookup Vals").Range("P:R"), 2, False)
    ws.Cells(mRow, 12).Value = Format(Me.TxtRD.Value, "DD/MM/YYYY")
    ws.Cells(mRow, 13).Value = ComboPD.Value
    ws.Cells(mRow, 14).Value = ComboNP.Value
    ws.Cells(mRow, 15).Value = ComboBd.Value
    ws.Cells(mRow, 16).Value = ComboCom.Value
    ws.Cells(mRow, 17).Value = TxtAdditional.Value
    ws.Cells(mRow, 18).Value = Format(Me.TxtDD.Value, "DD/MM/YYYY")
    ws.Cells(mRow, 19).Value = TxtBn.Value
    ws.Cells(mRow, 20).Value = TxtFS.Value
    ws.Cells(mRow, 21).Value = ComboPr.Value
    ws.Cells(mRow, 22).Value = ComboIs.Value
    ws.Cells(mRow, 23).Value = TxtUn.Value
    ws.Cells(mRow, 24).Value = TxtWt.Value
    ws.Cells(mRow, 25).Value = TxtIn.Value
    ws.Cells(mRow, 26).Value = TxtDt.Value
    ws.Cells(mRow, 27).Value = TxtShp.Value

    Next ws

1 个答案:

答案 0 :(得分:0)

功能怎么样:

Function GetNextId(ws As Worksheet, col As Variant) As Long
    GetNextId = WorksheetFunction.Max(ws.Columns(col)) + 1
End Function

简单地称之为:

Nextnum = GetNextId(Sheets("MasterData"), "A")
' or: Nextnum = GetNextId(Sheets("MasterData"), 1)
Xnum = GetNextId(Sheets("X"), "A"))