全部版块 我的主页
论坛 站务区 十一区 新手入门区
1865 0
2013-08-27

跨工作簿台账录入:

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



二维码

扫码加我 拉你入群

请注明:姓名-公司-职位

以便审核进群资格,未注明则拒绝

相关推荐
栏目导航
热门文章
推荐文章

说点什么

分享

扫码加好友,拉您进群
各岗位、行业、专业交流群