excel表链接excel表_职场


Private Sub Worksheet_Change(ByVal Target As Range)
'对查询条件 配件名称 取合适的字段(名称-peijian)

If Target.Row = 3 And Target.Column = 3 Then
    Application.EnableEvents = False
    Target = Mid(Target, 6, 20)
    Application.EnableEvents = True
End If

End Sub

Private Sub CommandButton1_Click()
'对 现存量查询按钮 功能的实现

Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strsql As String
Dim i As Integer
Dim j As Integer
Dim rnum As Integer

Application.ScreenUpdating = False

'********************************
'*                              *
'*  只查询指定配件名称的现存量  *
'*                              *
'********************************

If Cells(3, 3) <> "" Then
Application.EnableEvents = False
rnum = Sheet2.Cells(Rows.Count, 3).End(xlUp).Row '基础信息表sheet2中 配件信息的行数
i = 1
Do While i <= rnum
    If Cells(3, 3) = Sheet2.Cells(i, 3) Then
        Cells(6, 2) = Sheet2.Cells(i, 2)     '配件代码
        Cells(6, 3) = Cells(3, 3)            '配件名称
        Cells(6, 4) = Sheet2.Cells(i, 4)     '规格型号
        Cells(6, 5) = Sheet2.Cells(i, 5)     '单位
        Cells(6, 6) = Sheet2.Cells(i, 6)     '期初数量
        Exit Do
    Else
        i = i + 1
    End If
Loop

'********* 添加 入库数 开始 *********
cnn.Open "provider=Microsoft.Jet.OleDb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
strsql = "select 配件代码,配件名称,规格型号,单位,sum(入库数量) as 入库数量 from [入库明细$] group by 配件代码,配件名称,规格型号,单位"
rst.Open strsql, cnn, adOpenKeyset
       
rst.MoveFirst
Do While Not rst.EOF
    If Cells(3, 3) = rst.Fields(1) Then
        Cells(6, 7) = rst.Fields(4)
        Exit Do
    Else
        rst.MoveNext
    End If
Loop

rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'********* 添加 入库数 完毕 *********

'********* 添加 出库数 开始 *********
cnn.Open "provider=Microsoft.Jet.OleDb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
strsql = "select 配件代码,配件名称,规格型号,单位,sum(出库数量) as 出库数量 from [出库明细$] group by 配件代码,配件名称,规格型号,单位"
rst.Open strsql, cnn, adOpenKeyset

rst.MoveFirst
Do While Not rst.EOF
    If Cells(3, 3) = rst.Fields(1) Then
        Cells(6, 8) = rst.Fields(4)
        Exit Do
    Else
        rst.MoveNext
    End If
Loop

rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'********* 添加 出库数 完毕 *********

Cells(6, 9) = Cells(6, 6) + Cells(6, 7) - Cells(6, 8)
Application.EnableEvents = True

End If

'********************************
'*                              *
'*     查询所有配件的现存量     *
'*                              *
'********************************

If Cells(3, 3) = "" Then
    Application.EnableEvents = False
    rnum = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
    For i = 1 To rnum
        Cells(i + 5, 2) = Sheet2.Cells(i, 2)
        Cells(i + 5, 3) = Sheet2.Cells(i, 3)
        Cells(i + 5, 4) = Sheet2.Cells(i, 4)
        Cells(i + 5, 5) = Sheet2.Cells(i, 5)
        Cells(i + 5, 6) = Sheet2.Cells(i, 6)
    Next i
    Application.EnableEvents = True
      
'********* 添加 入库数 开始 *********
cnn.Open "provider=Microsoft.Jet.OleDb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
strsql = "select 配件代码,配件名称,规格型号,单位,sum(入库数量) as 入库数量 from [入库明细$] group by 配件代码,配件名称,规格型号,单位"
rst.Open strsql, cnn, adOpenKeyset
       
rst.MoveFirst
Do While Not rst.EOF
    For i = 6 To rnum
        If Cells(i, 2) = rst.Fields(0) Then
            Cells(i, 7) = rst.Fields(4)
            Exit For
        End If
    Next i
    rst.MoveNext
Loop

rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'********* 添加 入库数 完毕 *********

'********* 添加 入库数 开始 *********
cnn.Open "provider=Microsoft.Jet.OleDb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
strsql = "select 配件代码,配件名称,规格型号,单位,sum(出库数量) as 出库数量 from [出库明细$] group by 配件代码,配件名称,规格型号,单位"
rst.Open strsql, cnn, adOpenKeyset
       
rst.MoveFirst
Do While Not rst.EOF
    For i = 6 To rnum
        If Cells(i, 2) = rst.Fields(0) Then
            Cells(i, 8) = rst.Fields(4)
            Exit For
        End If
    Next i
    rst.MoveNext
Loop

rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'********* 添加 入库数 完毕 *********
rnum = Cells(Rows.Count, 2).End(xlUp).Row
For i = 6 To rnum
    Cells(i, 9) = Cells(i, 6) + Cells(i, 7) - Cells(i, 8)
Next i
Application.EnableEvents = True

End If

Application.ScreenUpdating = True

End Sub

Private Sub CommandButton2_Click()
Dim rnum As Integer
Dim i As Integer
Dim j As Integer

Application.ScreenUpdating = False

Cells(3, 3) = ""
rnum = Cells(Rows.Count, 2).End(xlUp).Row

If rnum > 5 Then
    Range(Cells(6, 2), Cells(rnum, 9)).ClearContents
End If

Application.ScreenUpdating = True

End Sub

Private Sub CommandButton3_Click()

Sheets("主界面").Activate
Sheets("主界面").Visible = True
Sheets("现存量查询").Visible = False

End Sub