问题描述
您好,感谢您提供的任何帮助。因此,我有一个用于编辑主数据库的用户窗体,它看起来像这样:
输入序列号后,我正在使用Vlookup在用户窗体中获取详细信息。代码如下:
Private Sub txtSerial_AfterUpdate()
Application.ScreenUpdating = False
Application.AutomationSecurity = msoAutomationSecurityLow
Dim nwb As Workbook
Dim sh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set nwb = Workbooks.Open("Online sharepoint location")
Set sh = nwb.Sheets("Summary")
If WorksheetFunction.CountIf(sh.Range("A:A"),EditForm.txtSerial.Value) = 0 Then
MsgBox "This is an incorrect ID"
Exit Sub
End If
X = EditForm.txtSerial.Value
With EditForm
.txtProject = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),sh.Range("A:R"),3,0)
.txtTeam = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),4,0)
.txtAPL = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),5,0)
.txtAE = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),6,0)
.cmbRelease = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),7,0)
.cmbDS = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),8,0)
.txtBatches = CInt(Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),9,0))
.dtReview.Value = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),10,0)
.dtSubmission.Value = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),11,0)
.dtRelease.Value = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),12,0)
.dtPlanned.Value = Format(Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),13,0),"dd/mm/yyyy")
.cmbPriority = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),14,0)
.txtRemarks = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),15,0)
.txtQA = Application.WorksheetFunction.VLookup(CLng(EditForm.txtSerial),17,0)
End With
nwb.Close
结束子
然后,我还要尝试编辑数据库并跟踪更改。该代码如下:
Sub Edit()
'On Error GoTo eh
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AutomationSecurity = msoAutomationSecurityLow
TryAgain:
Dim nwb As Workbook
Set nwb = Workbooks.Open("Online sharepoint location")
Dim iRow As Long
iRow = WorksheetFunction.CountA(nwb.Sheets("Audit Trail").Range("A:A")) + 1
nwb.Sheets("Summary").Unprotect Password:="pass"
nwb.Sheets("Audit Trail").Unprotect Password:="pass"
Dim id As Range
Set id = nwb.Sheets("Summary").Range("A:A").Find(what:=EditForm.txtSerial.Value,LookIn:=xlValues)
oldValues = ""
newValues = ""
titles = ""
LogChanges id.Offset(,2),EditForm.txtProject.Value
LogChanges id.Offset(,3),EditForm.txtTeam.Value
LogChanges id.Offset(,4),EditForm.txtAPL.Value
LogChanges id.Offset(,5),EditForm.txtAE.Value
LogChanges id.Offset(,6),EditForm.cmbRelease.Value
LogChanges id.Offset(,7),EditForm.cmbDS.Value
LogChanges id.Offset(,8),EditForm.txtBatches.Value
LogChanges id.Offset(,9),EditForm.dtReview.Value
LogChanges id.Offset(,10),EditForm.dtSubmission.Value
LogChanges id.Offset(,11),EditForm.dtRelease.Value
LogChanges id.Offset(,12),EditForm.dtPlanned.Value
LogChanges id.Offset(,13),EditForm.cmbPriority.Value
LogChanges id.Offset(,14),EditForm.txtRemarks.Value
LogChanges id.Offset(,16),EditForm.txtQA.Value
nwb.Sheets("Summary").Protect Password:="pass"
If Len(titles) > 0 Then
With Worksheets("Audit Trail")
.Cells(iRow,1) = iRow - 1
.Cells(iRow,2) = EditForm.txtSerial.Value
.Cells(iRow,3) = titles
.Cells(iRow,4) = oldValues
.Cells(iRow,5) = newValues
.Cells(iRow,6) = frm6.txtJust.Value
.Cells(iRow,7) = Application.UserName
.Cells(iRow,8) = [Text(Now(),"DD-MM-YYYY HH:MM:SS")]
End With
nwb.Sheets("Audit Trail").Protect Password:="pass"
'nwb.Sheets("Audit Trail").Visible xlSheetVeryHidden
End If
Unload frm6
'MsgBox (titles)
'MsgBox ("Changes edited succesfully and recorded in Audit trail sheet")
'nwb.Save
nwb.SaveAs Filename:="Online Sharepoint location"
nwb.Close
MsgBox ("Changes edited succesfully and recorded in Audit trail sheet")
Unload EditForm
Exit Sub
'eh:
'Ans = MsgBox("Another user is submitting their entry,please wait for a few seconds and then try again.",vbRetryCancel + vbCritical)
'If Ans = vbRetry Then Resume TryAgain
End Sub
LogChanges函数:
Sub LogChanges(c As Range,vNew)
With c
sep = IIf(Len(titles) > 0,"; ","") 'need a separator?
If .Value <> vNew Then
'track the changes
titles = titles & sep & .Parent.Cells(1,.Column).Value 'column titles in Row1
oldValues = oldValues & sep & ValueOrBlank(.Value) 'track old value
newValues = newValues & sep & ValueOrBlank(vNew) 'track new value
.Value = vNew 'update the cell
End If
End With
End Sub
Function ValueOrBlank(v)
ValueOrBlank = IIf(Len(v) > 0,v,"[blank]")
End Function
除2个字段外,其他所有内容均按预期工作:批数-由于其为数字,而计划发布日期为其文本字段日期。我必须将该日期保留在文本字段中,因为它不是必填字段。
这是审计跟踪表的屏幕截图,还有我的问题:
在最后一行中,您可以看到批次的数量和计划的日期,而由于我没有更改,所以它们不应该拥有
关于批处理的数量,我尝试在其中放置文本,然后它开始正常工作。所以问题是因为它是一个数字。请帮忙
解决方法
批次数 - 首先尝试将您比较的每个项目强制转换为数字类型,然后将两个强制数字变量相互比较。
日期问题 - 由于日期不是强制性的,您已选择使用文本。我建议使用日期类型,并以另一种方式解决“非强制性”的影响。例如:
- 验证为日期或空/空白
- 将 0(在 excel 中显示为 1/1/1900 或 1/1/1904 等)解释为零、空或空白,而不是解析日期,仅将实际日期存储为日期
存储为数据类型将避免您在区域显示选项中看到的日期问题,显示日期输入的不同文本表示,以及许多其他类似问题。