使用用户表单查找和更新多个表格

时间:2017-08-22 11:39:35

标签: database excel vba excel-vba

我有一个userform,它根据特定条件将数据发送到同一工作簿中的多个工作表。 ws1ws2ws3ws4 ws1是包含所有条目的主表,3个相应的工作表是信息最终结束的位置,具体取决于标准费用

我现在要做的是插入更新功能。每行都有一个参考。如果一行符合ws2的条件,那么它将获得第二个参考。

将数据放入工作表中的代码如下。我已经考虑过使用foundcell函数来查找然后更新参考编号,但是我只能让它更新母版,而不是更新其他图纸1或2张上的相同条目,可能包含该条目。

我不确定是否也可以,但我希望看看VBA是否仍然可以使用资格标准从ws2中删除条目,如果更新更改了符合条件,则移至ws3。有人可以帮忙吗?

数据输入代码

Private Sub EnterDetails_Click()

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 = GetNextId(Sheets("MasterData"), "A")
Xnum = GetNextId(Sheets("X"), "AB")

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 TxtWt.Value * (1300 / 1000) >= 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 TxtWt.Value * (1300 / 1000) >= 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 TxtWt.Value * (1300 / 1000) < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "Y" And TxtWt.Value * (1300 / 1000) < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws2, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 3: TargetWorksheets = Array(ws1, ws2, ws4)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 3: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And TxtWt.Value * (1300 / 1000) < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "Y" And TxtWt.Value * (1300 / 1000) < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 3: TargetWorksheets = Array(ws1, ws4)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) < 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: TargetWorksheets = Array(ws1, ws3)
        Case ComboPD.Value = "N" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) < 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 = DateSerial(Year(ws.Cells(mRow, 2)), Month(ws.Cells(mRow, 2)), 1)
    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(ComboBrd.Value, Sheets("Lookup Vals").Range("G:H"), 2, False)
    ws.Cells(mRow, 10).Value = Application.UserName
               If ComboBrd.Value = "Myson" Then ws.Cells(mRow, 11).Value = Application.WorksheetFunction.VLookup(ComboCom.Value, Sheets("Lookup Vals").Range("L:N"), 2, False) Else
               If ComboBrd.Value = "Purmo" Then ws.Cells(mRow, 11).Value = Application.WorksheetFunction.VLookup(ComboCom.Value, Sheets("Lookup Vals").Range("P:R"), 2, False) Else
                   If ComboBrd.Value = "Vogel & Noot" 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 = ComboBrd.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 = ComboPrGp.Value
    ws.Cells(mRow, 22).Value = ComboIss.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 = TxtDetails.Value
    ws.Cells(mRow, 27).Value = TxtSp.Value

Select Case True

        Case ComboPD.Value = "Y" And ComboNP.Value = "Y" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 1: ws.Cells(mRow, 28).Value = Xnum
        Case ComboPD.Value = "Y" And ComboNP.Value = "Y" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 1: ws.Cells(mRow, 28).Value = Xnum
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) <= 3: ws.Cells(mRow, 28).Value = Xnum
        Case ComboPD.Value = "Y" And ComboNP.Value = "N" And TxtWt.Value * (1300 / 1000) >= 50 And DateValue(Me.TxtRD.Value) - DateValue(Me.TxtDD.Value) > 3: ws.Cells(mRow, 28).Value = Xnum

End Select

   Next ws

        TxtRD.Value = ""
        ComboBrd.Value = ""
        ComboPD.Value = ""
        ComboNP.Value = ""
        ComboBrd.Value = ""
        ComboCom.Value = ""
        TxtAdditional.Value = ""
        TxtDD.Value = ""
        TxtBn.Value = ""
        TxtFS.Value = ""
        ComboPrGp.Value = ""
        ComboIss.Value = ""
        TxtUn.Value = ""
        TxtWt.Value = ""
        TxtIn.Value = ""
        TxtDetails.Value = ""
        TxtSp.Value = ""

    ActiveWorkbook.Save

End Sub

更新代码

Private Sub Update_Click()

Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet

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

mysearch = Me.Search.Value

    With ThisWorkbook.Sheets("MasterData")
        Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With

    Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not foundCell Is Nothing Then
            foundCell.Offset(0, 11).Value = Me.RD.Value
            foundCell.Offset(0, 17).Value = Me.DD.Value
            foundCell.Offset(0, 12).Value = Me.PD.Value
            foundCell.Offset(0, 13).Value = Me.NP.Value
            foundCell.Offset(0, 14).Value = Me.Brd.Value
            foundCell.Offset(0, 15).Value = Me.Com.Value
            foundCell.Offset(0, 25).Value = Me.Details.Value
            foundCell.Offset(0, 20).Value = Me.Prgp.Value
            foundCell.Offset(0, 21).Value = Me.Iss.Value
            foundCell.Offset(0, 7).Value = Me.CVal.Value
            foundCell.Offset(0, 22).Value = Me.Un.Value
            foundCell.Offset(0, 23).Value = Me.Wt.Value
            foundCell.Offset(0, 24).Value = Me.In.Value
            foundCell.Offset(0, 26).Value = Me.Sp.Value
            foundCell.Offset(0, 19).Value = Me.FS.Value
            foundCell.Offset(0, 18).Value = Me.LN.Value
            foundCell.Offset(0, 16).Value = Me.Add.Value

    Else
         MsgBox "ID does not exist."
    End If

End Sub

0 个答案:

没有答案