数据输入temlplate无重复

时间:2019-01-05 17:56:20

标签: excel vba excel-vba

不是专家,但需要帮助... Iam开发了一个excel宏,用于数据输入,这是我的项目的一部分。

  1. 我在sheet1(数据输入表单)中输入的所有数据都应保存在sheet2中。
  2. 每当我在sheet2中输入现有员工ID时,我都需要弹出带有味精“数据可用”的窗口,并应在相应的列中反映出来
  3. 无论何时我为上述情况输入数据“ sheet2中已经存在数据),尽管有相同信息,其余值也应通过分隔逗号添加到现有信息中,以相同的标题保存在sheet 2中。
  4. 除了为现有员工ID添加信息外,不应为同一员工ID创建重复记录

我尝试过的Excel VBA宏

我需要通过在工作表1中输入信息来在工作表2中提供以下详细信息

输入票证编号 输入员工编号 选择门卫 将票证分配给(第一级) 1级Val状态 将票分配给(第二层) 2级Val状态 质量检查完成者 详细说明已发送 备注

代码:

Private Sub CommandButton1_Click()
Dim TicketID As String, Dat As Date, Clientname As String
Dim EmpID As Double, Gatekeep As String, fisrtlevelname As String
Dim firstlevelStatus As String, secondlevelname As String, Secondlevelstatus As String, QA As String, Remarks As String
Worksheets("Sheet1").Select
TicketID = Range("B2")
Dat = Range("B3")
Clientname = Range("B4")
EmpID = Range("B5")
Gatekeep = Range("B6")
fisrtlevelname = Range("B7")
firstlevelStatus = Range("B8")
secondlevelname = Range("B9")
Secondlevelstatus = Range("B10")
QA = Range("B11")
Remarks = Range("B12")
Worksheets("Sheet2").Select
Worksheets("Sheet2").Range("A1").Select
If Worksheets("Sheet2").Range("A1").Offset(1, 0) <> "" Then
Worksheets("Sheet2").Range("A1").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = TicketID
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Dat
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Clientname
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = EmpID
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Gatekeep
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = fisrtlevelname
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = firstlevelStatus
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = secondlevelname
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Secondlevelstatus
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = QA
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Remarks
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range("B2").Select
End Sub

1 个答案:

答案 0 :(得分:0)

要尝试的新代码:假设员工ID需要覆盖输入的其余部分,而只有与现有数据进行比较。

Sub TryThis()
Dim Data As Variant
'Loads your data into an array beginning at (1,1) and ending at (11,1)
Worksheets("Sheet1").Activate
Data = Range("B2", "B12")
'Selects worksheet 2 and puts in your data. I personally don't like the .activate, but for a simple program
'that this seems to be, it shouldn't hurt your performance.
Worksheets("Sheet2").Activate
    'evaluates if it is the first entry by determing if cell is empty
    If Range("A2") <> "" Then
        'If it is not empty, sheet2 is put into an array (an array is overkill unless you have a lot of data)
        Dim Comp As Variant
        Comp = Range("A2", Range("A1").End(xlDown).End(xlToRight))
        'looks at each employee ID already existing in sheet2
        For i = 1 To UBound(Comp)
            'If the employee Id exists, it will write over it here.
            If Data(4, 1) = Comp(i, 4) Then
                MsgBox "Employee ID Exists" & vbNewLine & "Employee Information Updated"
                Dim CCount As Long
                CCount = 1
                Do Until CCount = 11
                    'used i + 1 because of your header on sheet2 and was too lazy to create a new variable
                    Cells(i + 1, CCount).Value = Data(CCount, 1)
                    CCount = CCount + 1
                Loop
            Worksheets("Sheet1").Activate
            'Resets your input range
            Range("B2:B17").Value = ""
            'Since the information is written here, it will exit sub for next entry
            Exit Sub
            End If
        Next i
    End If

        Dim RCount As Long
        RCount = 2
        Do Until Cells(RCount, 2) = ""
            RCount = RCount + 1
        Loop

        CCount = 1
        Do Until CCount = 11
            Cells(RCount, CCount).Value = Data(CCount, 1)
            CCount = CCount + 1
        Loop
        MsgBox "New Employee Id" & vbNewLine & "New Information Added"
        Worksheets("Sheet1").Activate
        Range("B2:B12").Value = ""
End Sub    

给出了原始代码

Sub TryThis()
Dim Data As Variant
'Loads your data into an array beginning at (1,1) and ending at (11,1)
Worksheets("Sheet1").Activate
    Data = Range("B2", "B18")

'Selects worksheet 2 and puts in your data. I personally don't like the .activate, but for a simple 
'program that this seems to be, it shouldn't hurt your performance.
Worksheets("Sheet2").Activate
    Dim RCount As Long
    RCount = 2
        Do Until Cells(RCount, 2) = ""
        RCount = RCount + 1
        Loop
    Dim CCount As Long
    CCount = 1
        Do Until CCount = 17
            Cells(RCount, CCount).Value = Data(CCount, 1)
            CCount = CCount + 1
        Loop
End Sub