Ввод данных temlplate без дубликатов - PullRequest
0 голосов
/ 05 января 2019

Я не эксперт, но мне нужна одна помощь ... Я разрабатываю один макрос Excel для ввода данных в рамках моего проекта.

  1. все данные, которые я ввожу в лист1 (форма ввода данных), следует сохранять в листе 2.
  2. всякий раз, когда я вношу существующий идентификатор сотрудника в sheet2, мне нужно получить всплывающее окно с сообщением "данные доступны" и должно отображаться в соответствующих столбцах
  3. всякий раз, когда я ввожу данные для вышеприведенного случая "данные уже существуют на листе 2), несмотря на ту же информацию, оставшиеся значения следует сохранять на листе 2 под тем же заголовком, добавляя к существующей информации, разделяя запятую.
  4. Повторяющаяся запись не должна создаваться для того же идентификатора сотрудника, за исключением добавления информации к существующей

Макрос Excel VBA, который я пробовал

Мне нужно ниже детали в листе 2, введя информацию в листе1

Введите номер билета Введите идентификатор сотрудника Выберите Gate Keeper Назначить билет на (1-й уровень) 1-й уровень Val Статус Назначить билет на (2-й уровень) 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 голосов
/ 06 января 2019

Новый код для попытки: предполагается, что идентификатор сотрудника должен перезаписывать оставшуюся часть ввода, только сравнение, выполненное с существующими данными.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...