EXCEL的VBA公式,求修改下

2025-03-20 10:41:42
推荐回答(1个)
回答1:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 17 Or Target.Count > 1 Then Exit Sub
    BackOpen "珠宝行.xlsm"
    BackOpen "采购入库打标.xlsx"
    If Target.Offset(0, 5) <= 0 And Target.Offset(0, 0) = "千足" And Target.Offset(0, -10) <> "配件" Then
        Target.Offset(0, 5) = Target.Offset(0, 5) + 1
        AppendLine Target, Workbooks("珠宝行.xlsm").Sheets("首饰")
        AppendLine Target, Workbooks("采购入库打标.xlsx").Sheets("首饰")
    End If
End Sub

'检测n是否打开,没有打开则打开(必须在同一文件夹)
Private Sub BackOpen(ByVal n)
    Dim wb As Workbook
    Set wb = Nothing
    On Error Resume Next
    Set wb = Workbooks(n)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = ActiveWorkbook
        Workbooks.Open ThisWorkbook.Path & "\" & n
        wb.Activate
    End If
End Sub

'把r添加到t的末尾
Private Sub AppendLine(ByRef r As Range, ByRef t As Worksheet)
    Dim n As Long
    n = t.UsedRange.Rows.Count + 1
    r.EntireRow.Copy t.Rows(n)
End Sub