跨工作簿台账录入:
Sub 按钮2_Click()
On Error Resume Next
Set wb = GetObject("e:\销售台账.xlsm")
mm = wb.Sheets("销售台账").Cells(Rows.Count, 4).End(xlUp).Row
n = Application.Match(ThisWorkbook.Sheets("台账登录").Range("c2"), wb.Sheets("销售台账").Range("d1:d" & mm))
wb.Sheets("销售台账").Range("h" & n) = ThisWorkbook.Sheets("台账登录").Range("i2")
wb.Sheets("销售台账").Range("i" & n) = ThisWorkbook.Sheets("台账登录").Range("c4")
wb.Sheets("销售台账").Range("j" & n) = ThisWorkbook.Sheets("台账登录").Range("c6")
wb.Sheets("销售台账").Range("k" & n) = ThisWorkbook.Sheets("台账登录").Range("f6")
wb.Sheets("销售台账").Range("l" & n) = ThisWorkbook.Sheets("台账登录").Range("f9")
wb.Sheets("销售台账").Range("m" & n) = ThisWorkbook.Sheets("台账登录").Range("c9")
wb.Sheets("销售台账").Range("n" & n) = ThisWorkbook.Sheets("台账登录").Range("f3")
wb.Sheets("销售台账").Range("o" & n) = ThisWorkbook.Sheets("台账登录").Range("i3")
wb.Sheets("销售台账").Range("p" & n) = ThisWorkbook.Sheets("台账登录").Range("c8")
wb.Sheets("销售台账").Range("q" & n) = ThisWorkbook.Sheets("台账登录").Range("f8")
wb.Sheets("销售台账").Range("r" & n) = ThisWorkbook.Sheets("台账登录").Range("f7")
wb.Sheets("销售台账").Range("s" & n) = ThisWorkbook.Sheets("台账登录").Range("c7")
wb.Sheets("销售台账").Range("t" & n) = ThisWorkbook.Sheets("台账登录").Range("c10")
wb.Sheets("销售台账").Range("v" & n) = ThisWorkbook.Sheets("台账登录").Range("c5")
wb.Sheets("销售台账").Range("w" & n) = ThisWorkbook.Sheets("台账登录").Range("f4")
wb.Sheets("销售台账").Range("x" & n) = ThisWorkbook.Sheets("台账登录").Range("h4")
wb.Sheets("销售台账").Range("y" & n) = ThisWorkbook.Sheets("台账登录").Range("i5")
wb.Sheets("销售台账").Range("z" & n) = ThisWorkbook.Sheets("台账登录").Range("g5")
ThisWorkbook.Sheets("台账登录").Range("c2") = ""
ThisWorkbook.Sheets("台账登录").Range("i2") = ""
ThisWorkbook.Sheets("台账登录").Range("c4") = ""
ThisWorkbook.Sheets("台账登录").Range("f4") = ""
ThisWorkbook.Sheets("台账登录").Range("h4") = ""
ThisWorkbook.Sheets("台账登录").Range("c5") = ""
ThisWorkbook.Sheets("台账登录").Range("g5") = ""
ThisWorkbook.Sheets("台账登录").Range("i5") = ""
ThisWorkbook.Sheets("台账登录").Range("c6") = ""
ThisWorkbook.Sheets("台账登录").Range("f6") = ""
ThisWorkbook.Sheets("台账登录").Range("i6") = ""
ThisWorkbook.Sheets("台账登录").Range("c7") = ""
ThisWorkbook.Sheets("台账登录").Range("f7") = ""
ThisWorkbook.Sheets("台账登录").Range("i7") = ""
ThisWorkbook.Sheets("台账登录").Range("i8") = ""
ThisWorkbook.Sheets("台账登录").Range("c9") = ""
ThisWorkbook.Sheets("台账登录").Range("f9") = ""
ThisWorkbook.Sheets("台账登录").Range("i9") = ""
ThisWorkbook.Sheets("台账登录").Range("c10") = ""
ThisWorkbook.Sheets("台账登录").Range("f10") = ""
ThisWorkbook.Sheets("台账登录").Range("e11") = ""
ThisWorkbook.Sheets("台账登录").Range("g11") = ""
ThisWorkbook.Sheets("台账登录").Range("i11") = ""
wb.Save
wb.Close False
End Sub
台账录入提取数据:
Sub 按钮3_Click()
On Error Resume Next
Set wb = GetObject("e:\销售台账.xlsm")
mm = wb.Sheets("销售台账").Cells(Rows.Count, 4).End(xlUp).Row
n = Application.Match(ThisWorkbook.Sheets("台账登录").Range("c2"), wb.Sheets("销售台账").Range("d1:d" & mm))
If (wb.Sheets("销售台账").Range("h" & n) = "") Then
wb.Sheets("销售台账").Range("h" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("i2") = wb.Sheets("销售台账").Range("h" & n)
End If
If (wb.Sheets("销售台账").Range("i" & n) = "") Then
wb.Sheets("销售台账").Range("i" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("c4") = wb.Sheets("销售台账").Range("i" & n)
End If
If (wb.Sheets("销售台账").Range("j" & n) = "") Then
wb.Sheets("销售台账").Range("j" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("c6") = wb.Sheets("销售台账").Range("j" & n)
End If
If (wb.Sheets("销售台账").Range("k" & n) = "") Then
wb.Sheets("销售台账").Range("k" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("f6") = wb.Sheets("销售台账").Range("k" & n)
End If
If (wb.Sheets("销售台账").Range("l" & n) = "") Then
wb.Sheets("销售台账").Range("l" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("f9") = wb.Sheets("销售台账").Range("l" & n)
End If
If (wb.Sheets("销售台账").Range("m" & n) = "") Then
wb.Sheets("销售台账").Range("m" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("c9") = wb.Sheets("销售台账").Range("m" & n)
End If
If (wb.Sheets("销售台账").Range("r" & n) = "") Then
wb.Sheets("销售台账").Range("r" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("f7") = wb.Sheets("销售台账").Range("r" & n)
End If
If (wb.Sheets("销售台账").Range("s" & n) = "") Then
wb.Sheets("销售台账").Range("s" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("c7") = wb.Sheets("销售台账").Range("s" & n)
End If
If (wb.Sheets("销售台账").Range("t" & n) = "") Then
wb.Sheets("销售台账").Range("t" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("c10") = wb.Sheets("销售台账").Range("t" & n)
End If
If (wb.Sheets("销售台账").Range("v" & n) = "") Then
wb.Sheets("销售台账").Range("v" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("c5") = wb.Sheets("销售台账").Range("v" & n)
End If
If (wb.Sheets("销售台账").Range("w" & n) = "") Then
wb.Sheets("销售台账").Range("w" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("f4") = wb.Sheets("销售台账").Range("w" & n)
End If
If (wb.Sheets("销售台账").Range("x" & n) = "") Then
wb.Sheets("销售台账").Range("x" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("h4") = wb.Sheets("销售台账").Range("x" & n)
End If
If (wb.Sheets("销售台账").Range("y" & n) = "") Then
wb.Sheets("销售台账").Range("y" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("i5") = wb.Sheets("销售台账").Range("y" & n)
End If
If (wb.Sheets("销售台账").Range("z" & n) = "") Then
wb.Sheets("销售台账").Range("z" & n) = ""
Else
ThisWorkbook.Sheets("台账登录").Range("g5") = wb.Sheets("销售台账").Range("z" & n)
End If
wb.Close False
End Sub
锁定单元格:
Dim Str As String
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) '双击运行代码
Dim Pass, s
If Target.Cells(1).Value <> "" Then
Pass = InputBox("请输入修改密码:", "提示")
If Pass <> "123456" Then
Application.EnableEvents = False
Target.Cells(1) = Str
Application.EnableEvents = True
MsgBox "密码错误,不能修改", vbOKOnly, "警告"
Target.Offset(1).Select
Else
Target.Cells(1).Select
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '自动运行代码
Str = Target.Cells(1).Value
End Sub