我有一个工作簿可以从其他几个工作表中获取数据。通常,数据存储在每张纸的表格中。在这种情况下,一个表是我们存储订单的数据库的数据连接。
为了从每张纸上成功获取正确的数据,我创建了一个类似于此的“数据”子:
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
答案 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