Question

**我试图创建一个代码，其中我使用userform来验证一个值是否已经在列a中。然后，如果找到该值，它将使我写入或复制来自不同工作表的特定值。我这样做，所以当2个或更多用户保存此工作簿时，我可以避免冲突错误。我有这个代码，但每次2个或更多用户保存它给他们保存错误请帮助。

Sub CommandButton1_Click()


If ActiveWorkbook.MultiUserEditing Then
Workbooks("Satisfaction.xlsm").AcceptAllChanges
Workbooks("Satisfaction.xlsm").Save

End If

Application.ScreenUpdating = False

Dim lngWriteRow As Long

Dim ws As Worksheet
Set ws = Worksheets("Answers")

lngWriteRow = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row

If lngWriteRow < 1 Then lngWriteRow = 1

ws.Range("B" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("D25").Value
ws.Range("C" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("D26").Value
ws.Range("D" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("D27").Value
ws.Range("G" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E37").Value
ws.Range("H" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E45").Value
ws.Range("I" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E53").Value
ws.Range("J" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E61").Value
ws.Range("K" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E70").Value
ws.Range("L" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E79").Value
ws.Range("M" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E87").Value
ws.Range("N" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E96").Value
ws.Range("O" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E104").Value
ws.Range("P" & lngWriteRow) = ThisWorkbook.Sheets("Input").Range("E112").Value

ThisWorkbook.Sheets("Input").Range("D25").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("D26").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("D27").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E27").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E37").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E45").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E53").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E61").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E70").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E79").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E87").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E96").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E104").Select
Selection.ClearContents
ThisWorkbook.Sheets("Input").Range("E112").Select
Selection.ClearContents

ActiveWorkbook.Sheets("Intro").Visible = xlSheetVisible
ActiveWorkbook.Sheets("Input").Visible = xlSheetVeryHidden
Application.ScreenUpdating = True

MsgBox "Thank you for taking the exam"
Workbooks("Satisfaction.xlsm").Close SaveChanges:=True




End Sub

Answer 1

尝试在代码的最后一行之前添加以下行。

Workbooks("Satisfaction.xlsm").AcceptAllChanges
Workbooks("Satisfaction.xlsm").Save

如果在列上找到值，则在同一行上写入数据

1 个答案: