Question

我有以下Excel VBA代码从已关闭的工作簿中提取数据。宏工作并提取数据，但我的数据集包含合并到一个文件中的五个不同帐户的数据。我可以为该特定帐户提取数据的唯一方法是，如果我为该特定帐户设置了正确数量的数据行，但我必须从我的数据集中计算它，这样可以实现自动化的目的。

我想在下面的代码中添加动态计数函数vba代码。

假设我想要提取帐户“P 87848”的所有行数据。

Const NumRows& = 250

在Const NumRow＆amp;

中插入或实现计数功能的最佳方法是什么？

Sub GetDataDemo()

    Dim FilePath$, Row&, Column&, Address$
    Dim path As String


     'change constants & FilePath below to suit
     '***************************************
    Const FileName$ = "DNAV.xlsx"
    Const SheetName$ = "DNAV"
    Const NumRows& = 250
    Const NumColumns& = 15
    path = "C:\Documents\Marenco\VBA\"
     '***************************************

    DoEvents
    Application.ScreenUpdating = False
    If Dir(FilePath & FileName) = Empty Then
        MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
        Exit Sub
    End If
    For Row = 1 To NumRows
        For Column = 1 To NumColumns
            Address = Cells(Row, Column).Address
            Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
            Columns.AutoFit
        Next Column
    Next Row
    ActiveWindow.DisplayZeros = False
End Sub


Private Function GetData(path, File, Sheet, Address)
    Dim Data$
    Data = "'" & path & "[" & File & "]" & Sheet & "'!" & _
    Range(Address).Range("A1").Address(, , xlR1C1)
    GetData = ExecuteExcel4Macro(Data)
End Function

我的源数据。帐号在A列中，它有5个不同的帐户，从P 15001开始。每个帐户都有自己的模板。在这种情况下，我只想提取帐户P 15001的数据。列是常量，但行更改。

帐号安全ID数量成本本地市场价格市场价值本地

P 15001 AUD 276,250.00  276,250.00  1.00    276,250.00 
P 15001 B5790J3 4,000,000.00    4,086,200.00    110.60  4,424,080.00 
P 15001 B3XF8Z3 5,000,000.00    5,239,900.00    109.98  5,498,750.00 
P 15001 B50VKT6 5,000,000.00    5,134,250.00    103.37  5,168,300.00 
P 15001 CCTAUD  615,000.00  615,000.00  0.96    615,000.00 
P 15001 B3XQ210 6,900,000.00    7,090,440.00    101.82  7,025,511.00 
P 15001 B55HXF6 4,300,000.00    4,522,844.40    105.50  4,536,543.00 
P 15001 B4PM5Y7 2,900,000.00    3,145,730.42    112.29  3,256,381.00 
P 15001 CCTCAD  2,530,000.00    2,530,000.00    0.99    2,530,000.00 
P 15001 EUR 82,921.26   82,921.26   1.00    82,921.26 
P 15001 B5VVFK1 5,600,000.00    5,992,648.00    106.60  5,969,415.20 
P 15001 B10S9K3 7,270,000.00    8,794,985.99    124.58  9,056,960.88 
P 15001 B4XF7K8 10,530,000.00   12,079,614.58   118.06  12,431,696.94 
P 15001 B5V3C06 14,500,000.00   14,511,620.00   100.44  14,564,467.00 
P 15001 B54VTS4 35,150,000.00   35,922,019.50   104.24  36,640,535.75 
P 15001 B6YXBD6 3,580,000.00    3,719,341.36    109.04  3,903,753.72 
P 15001 B40Z1F4 2,530,000.00    2,814,675.60    111.38  2,817,797.62 
P 15001 B63GF45 6,150,000.00    7,170,378.00    117.56  7,229,884.65 
P 15001 B04FJB4 34,850,000.00   38,186,084.50   108.91  37,956,668.40 
P 15001 B45JHF3 9,200,000.00    9,935,736.49    105.81  9,734,547.60 
P 15001 B28VPL4 970,000.00  1,113,787.27    114.05  1,106,277.14

Answer 1

以下代码会将目标工作簿中的所有数据值复制到当前工作簿，并在目标工作簿列A中以“accounts”换页。

Sub getdata()
    Dim rows As Integer
    Dim cols As Integer
    Dim row As Integer
    Dim col As Integer
    Dim crow As Integer
    Dim acc As String

    DoEvents
    Application.ScreenUpdating = False
    On Error Resume Next
    Workbooks.Open Filename:="demo.xls"
    ThisWorkbook.Activate
    If Err.Number <> 0 Then
        Application.ScreenUpdating = True
        MsgBox "File does not exist"
        Exit Sub
    End If
    rows = Workbooks("demo.xls").Sheets(1).Range("A65536").End(xlUp).row
    cols = Workbooks("demo.xls").Sheets(1).Range("IV1").End(xlToLeft).Column
    For row = 1 To rows
        acc = Workbooks("demo.xls").Sheets(1).Cells(row, 1).Value
        If acc <> "" Then
            On Error Resume Next
            ThisWorkbook.Sheets(acc).Activate
            If Err.Number <> 0 Then
                ThisWorkbook.Sheets.Add().Name = acc
            End If
            crow = ThisWorkbook.Sheets(acc).Range("A65536").End(xlUp).row + 1
            For col = 2 To cols
                ThisWorkbook.Sheets(acc).Cells(crow, col - 1).Value = Workbooks("demo.xls").Sheets(1).Cells(row, col).Value
            Next
        End If
    Next
    'optional:
    'ThisWorkbook.SaveAs Filename:="YYYYMMDD.xls"
    Application.ScreenUpdating = True
End Sub

缺点：

原始图纸（Sheet1，Sheet2，Sheet3）将被保留----我试图删除它们，但代码似乎造成了麻烦;
每个“帐户”表格上都会有一个空行。

Answer 2

复制所有可能不是最好的主意，只需要解决类似的任务，在我的情况下，它超过1000000行和约56张所以复制所有需要时间。

我使用相同的方法来读取您的示例中的值，但是有验证规则，所以想法是检查您是否读取以及是否需要 - 保存到字符串数组，如果不跳过它 - 最好的结果是然后表按验证属性排序。子代码：

...
i = 2 'skiping hedears
flag = True 'flag to know then we need jump out of cicle
ScrMode = Application.ScreenUpdating 'save curent status
DoEvents 'allow others subs to do stuff
Application.ScreenUpdating = False 
Do While flag
    Address = Cells(i, ColNumber).Address 'there is colnumber where is validation value is stored, i - row count 
    strRetVal = GetData(DataFileName, SheetName, Address) 'get result
    If strRetVal <> "0" Then 'check if cell is empty (to know that its end of data column) in you case additional check required if returned result is = "P 15001"
        If strValString = "" Then
            strValString = strRetVal
        Else
            strValString = strValString & "," & strRetVal 'I am adding value there to long string, you may need to use few of them to collect all values you need, so one string variable per column
        End If
        i = i + 1
    Else
        flag = False
    End If
Loop
Application.ScreenUpdating = ScrMode 'restoring mode 
...

在此之后，您将获得一堆字符串，其中包含与验证字符串相关的所需数据。然后你可以将它保存到数组中：strValArray = Split（strValString，“，”）并在需要时将其传递给工作表。

Excel VBA计算已关闭工作簿中某个条件的行

帐号安全ID数量成本本地市场价格市场价值本地

2 个答案: