从表/表中存储行/列的最佳方法是什么?

时间:2015-05-06 06:58:00

标签: excel vba excel-vba

我有一个工作簿可以从其他几个工作表中获取数据。通常,数据存储在每张纸的表格中。在这种情况下,一个表是我们存储订单的数据库的数据连接。

为了从每张纸上成功获取正确的数据,我创建了一个类似于此的“数据”子:

Dim Wb(1 To 10) As Workbook
Dim Sh(1 To 10) As Worksheet
Dim Lo(1 To 10) As ListObject
Dim Ii&(1 To 10), Jj&(1 To 10), Kk&(1 To 10)

Sub Data()
    Set Wb(1) = ThisWorkbook
    Set Sh(1) = Wb(1).Worksheets("Input")
    Set Lo(1) = Sh(1).ListObjects("Input")
    With Lo(1)
        Ii(1) = .ListColumns("Date").Range.Column
        Ii(2) = .ListColumns("ArtNo").Range.Column
        Ii(3) = .ListColumns("ArtName").Range.Column
        Ii(4) = .ListColumns("ArtUnits").Range.Column ' Units in the article
        Ii(5) = .ListColumns("ArtLitres").Range.Column ' Litres in the article
        Ii(6) = .ListColumns("Quantity").Range.Column
        Ii(7) = .ListColumns("SumUnits").Range.Columne ' Units * Quantity
        Ii(8) = .ListColumns("SumLitres").Range.Columne ' Litres * Quantity
    End With

    ' Table from Database containing the orders
    Set Sh(2) = Wb(1).Worksheets("Orders")
    Set Lo(2) = Sh(2).ListObjects("Orders")
    With Lo(2)
        Jj(1) = .ListColumns("Date").Range.Column
        Jj(2) = .ListColumns("ArtNo").Range.Column
        Jj(6) = .ListColumns("Quantity").Range.Column
    End With

    ' Database containing detailed information on the articles
    Set Sh(3) = Wb(1).Worksheets("ArtData")
    Set Lo(3) = Sh(3).ListObjects("ArtData")
    With Lo(3)
        Kk(2) = .ListColumns("ArtNo").Range.Column
        Kk(3) = .ListColumns("ArtName").Range.Column
        Kk(4) = .ListColumns("ArtUnits").Range.Column ' Units in the article
        Kk(5) = .ListColumns("ArtLitres").Range.Column ' Litres in the article
    End With
End Sub

因此,当我运行Data子系统时,我知道所有相关列的位置。我已经看到每个数字代表相同的列名。我的意思是Ii(2),Jj(2)和Kk(2)都等于每个表中名为“ArtNo”的列。

我开始使用数组,因为它们更快地声明。而不是声明单独的整数,如“ArtNo1”,“ArtNo2”,“ArtNo3”或ArtNo(1到3),我只是知道数字(1)等于每个表中的ArtNo,我会使用一个数组(“Ii”,“Jj”,“Kk”)每张桌子。我只需要知道每个数字代表什么,最坏的情况;我会向上滚动到数据子并在那里得到答案。

为了获取数据我会做这样的事情:

Sub TransferData()
Dim dDate As Date
Dim Str$
Dim Cel As Range
Dim X&, Y&
    CalcOff
    Data
    Wb(1).RefreshAll ' Updates the Order data connection
    X = Lo(1).DataBodyRange.Row ' Get input row for the data
    Str = Format(dDate, "yyyy-mm-dd", vbMonday, vbFirstFourDays) ' Used for filtering the table

    ' Filtering the order database, showing only the chosen date
    Lo(2).AutoFilter.ShowAllData
    Lo(2).Range.AutoFilter Field:=Jj(1), Operator:=xlFilterValues, Criteria2:=Array(2, Str)

    With Sh(1)
        For Each Cel In Lo(2).ListColumns(Jj(2)).DataBodyRange.SpecialCells(xlCellTypeVisible)

            ' Transferring from the Order database
            .Cells(X, Ii(1)) = dDate
            .Cells(X, Ii(2)) = Cel
            .Cells(X, Ii(6)) = Sh(2).Cells(Cel.Row, Jj(6))

            ' Find the 'ArtNo' row from the Info database
            Y = Lo(3).ListColumns(Kk(2)).Find(Cel, LookIn:=xlValues, LookAt:=xlWhole).Row

            ' Transferring from the Info database
            .Cells(X, Ii(3)) = Sh(3).Cells(Y, Kk(3))
            .Cells(X, Ii(4)) = Sh(3).Cells(Y, Kk(4))
            .Cells(X, Ii(5)) = Sh(3).Cells(Y, Kk(5))

            ' Calculating units and litres
            .Cells(X, Ii(7)) = .Cells(X, Ii(6)) * .Cells(X, Ii(4))
            .Cells(X, Ii(8)) = .Cells(X, Ii(6)) * .Cells(X, Ii(5))

            X = X + 1
        Next Cel
    End With
    CalcOn
    End
End Sub

Function CalcOff()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
End Function

Function CalcOn()
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Function

我的问题是:

是否有更简单的方式来传输这样的数据?我正在考虑课程,但我从来没有和他们一起工作,所以我真的很感激,如果有人可以举例说明如何在进行像这样的转移时实现类。

请注意,代码只是一个快速编写的示例。我在每张表中都将所有表格放在“A1”处,否则我必须对每列进行以下操作:

Ii(1) = .ListColumns("Date").Range.Column - .Range.Column + 1

1 个答案:

答案 0 :(得分:1)

是。 使用Microsoft Query 。它不需要安装PowerQuery,因为它可以像Excel中的数据库链接一样可用。下面是在工作表之间传输数据的示例:

SELECT * FROM [Input$] as I INNER JOIN [AnotherWorksheet$] as A ON I.ArtNo = A.ArtNo

然后从VBA更新查询:

ActiveSheet.QueryTables(1).Refresh BackgroundQuery:=False

您可以从“数据”功能区选项卡(来自其他来源)或使用我的加载项(仅用于创建查询)创建Microsoft查询:link

以下是一个如何使用Iif根据星期几返回不同值的示例:

SELECT Iif( DatePart ("w", #05/07/2015#,2) = 1, 1,0) as StartMonday,
Iif( DatePart ("w", #05/07/2015#,2) = 2, 1,0) as StartTuesday, 
Iif( DatePart ("w", #05/07/2015#,2) = 3, 1,0) as StartWednesday,
Iif( DatePart ("w", #05/07/2015#,2) = 4, 1,0) as StartThursday,    
Iif( DatePart ("w", #05/07/2015#,2) = 5, 1,0) as StartFriday    

这将返回如下内容:

StartMonday | StartTuesday | StartWednesday | StartThursday | StartFriday
0           | 0            | 0              | 1             | 0