如果在列上找到值，則在同一行上寫入數據

Question

** im試圖創建一個代碼，其中im使用用戶窗體來驗證a列中是否已存在一個值。 然后，如果找到該值，它將使我編寫或復制其他工作表中的特定值。 即時通訊這樣做是為了避免2個或更多用戶保存此workbook.i時發生沖突錯誤，但每次有2個或更多用戶保存此代碼時，將為他們提供保存錯誤pls幫助。

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