larme / tmp.vb

Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next irow = Target.Row icol = Target.Column Application.EnableEvents = False Sheet1.Unprotect Password:="123" i = Sheet1.Range("a999999").End(xlUp).Row If icol = 1 And Sheet1.Range("b" & i) = "" Then j = Sheet2.Range("a999999").End(xlUp).Row m = Sheet1.Range("a" & i) For n = 2 To j If Sheet2.Range("A" & n) = m Then Z = i xm = n Do While Sheet2.Range("a" & xm) = Sheet2.Range("A" & n) '添加判断条件，跳过"代理O"的行 If Sheet2.Range("E" & xm) <> "代理O" Then Sheet1.Range("a" & Z) = Sheet2.Range("A" & xm) Sheet2.Range("b" & xm & ":g" & xm).Copy Sheet1.Range("b" & Z) Sheet1.Range("b" & Z).Copy Sheet1.Range("a" & Z).PasteSpecial Paste:=xlPasteFormats, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Z = Z + 1 End If xm = xm + 1 Loop Exit For End If Next End If Sheet1.Protect Password:="123" Application.EnableEvents = True End Sub Sub 打开() Application.EnableEvents = True End Sub Sub 清空() On Error Resume Next Sheet1.Unprotect Password:="123" i = MsgBox("是否清空数据？", vbOKCancel) If i = vbOK Then i = Sheet1.Range("a9999").End(xlUp).Row If i >= 3 Then Sheet1.Range("a3:g" & i).Delete Shift:=xlShiftUp End If End If Sheet1.Protect Password:="123" End Sub