不是专家,但需要帮助... Iam开发了一个excel宏,用于数据输入,这是我的项目的一部分。
我尝试过的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
答案 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