如何使用 VBA 2003 从 Excel 工作表中动态读取数据

how to read data from an excel worksheet dynamically using VBA 2003

提问by Fraiser

I am new to vba programming hence I need your expert help in trying to be able to able to read all values from the following excel sheet into a ADODB recordset object using VBA 2003

我是 vba 编程的新手，因此我需要您的专家帮助，以便能够使用 VBA 2003 将以下 excel 表中的所有值读取到 ADODB 记录集对象中

The recordset will be populated as follows

记录集将按如下方式填充

   'Create new recordset with the following fields
        Dim rsData as new ADODB.Recordset
        rsData.Fields.Append "Month", adVarChar, 20
        rsData.Fields.Append "Product", adVarChar, 20
        rsData.Fields.Append "Type", adVarChar, 50
        rsData.Fields.Append "Value", adVarChar, 50
        rsData.Open


    'for each row in spreadsheet read the following info
       rsData.Addnew
            rsData.Fields("Month") = 'value from row 2 Jan followed by data below
            rsData.Fields("Product") = "Color" ' Value from B5
            rsData.Fields("Type") = "MK1" ' value from C5
            rsData.Fields("Value") = "111=" ' value from D6

'Now move to next set of values for Feb

    rsData.Addnew
            rsData.Fields("Month") = 'value from row 2 FEB
            rsData.Fields("Product") = "Shade" ' Value from F5
            rsData.Fields("Type") = "AB2" ' value from G5
            rsData.Fields("Value") = "345=ABX" ' value from H5

    'Now move to next set of values for Mar
    rsData.Addnew
            rsData.Fields("Month") = 'value from row 2 MAR
            rsData.Fields("Product") = "Color" ' Value from F5
            rsData.Fields("Type") = "3FG" ' value from G5
            rsData.Fields("Value") = "PLZ" ' value from H5

    'Now move to next row
 rsData.Addnew
            rsData.Fields("Month") = 'value from row 2 Jan
            rsData.Fields("Product") = "Color" ' Value from F5
            rsData.Fields("Type") = "MK2" ' value from C6
            rsData.Fields("Value") = "234=BZX" ' value from D6

...and so on

Please note, **the data may move around but the overall layout will remain unchanged.

请注意，**数据可能会移动，但整体布局将保持不变。

As you can see from the following diagram. the order has changed: Jan , march, Feb**

如下图所示。顺序已更改：1 月、3 月、2 月**

回答by Alan K

Your problem isn't really VBA for Excel, the problem is that that's a garbage data source. If the blocks can move around and be in any order, you really have no easy way of telling where they'll be and how much data is in them. That being the case you'd be much better off asking the questions:

你的问题不是真正的 Excel 的 VBA，问题是那是一个垃圾数据源。如果这些块可以移动并以任何顺序排列，那么您真的没有简单的方法来判断它们将在哪里以及其中有多少数据。在这种情况下，您最好提出以下问题：

• Does the source data need to be in this format; and
• Is there a way that we can do it better?

• 源数据是否需要采用这种格式；和
• 有没有办法让我们做得更好？

("Better" = more structured, more predictable.)

（“更好”=更有条理，更可预测。）

Also you're thinking too much in terms of each row being a record. Each block is quite separate from the others and since each one has a unique "header record" (being the month) I'd be inclined to process each block in turn rather than trying to jump from one to the other as your sample code tries to do.

此外，您在每一行都是记录方面考虑得太多。每个块都与其他块完全分开，并且由于每个块都有一个唯一的“标题记录”（即月份），因此我倾向于依次处理每个块，而不是在示例代码尝试时尝试从一个块跳到另一个块去做。

The following should give you enough of a grounding to be able to navigate your way through an Excel worksheet. It's just something that I whacked together quickly and have not bullet-proofed though I did test it with a mock-up of the sheet in your second illustration and it did work. It should be enough to help set you on the right course, but I again emphasise... what you have is not a true data source. It's a report that needs to be almost arbitrarily parsed. You need to see whether that can be addressed before you do anything.

以下内容应该为您提供足够的基础，以便能够在 Excel 工作表中导航。这只是我快速拼凑起来的东西，虽然我确实在你的第二个插图中用一张纸的模型对其进行了测试，但它确实有效。它应该足以帮助您走上正确的道路，但我再次强调……您拥有的不是真正的数据源。这是一份几乎需要任意解析的报告。在你做任何事情之前，你需要看看是否可以解决这个问题。

Sub DemonstrateReadingFromExcel()

'Every cell in Excel is a range.
'A range can also be a collection of cells.
'Ranges have properties that you can query. More importantly
'you can redefine a range by offsetting it from
'your current range, which makes it easy to step through a block.
Dim rng_Month As Excel.Range
Dim rng_Data As Excel.Range

'Let's define some string variables that you can use to assign
'to your recordset's fields.
Dim s_Month As String
Dim s_Product As String
Dim s_Type As String
Dim s_Value As String

Dim l_RowCurrent As Long
Dim l_RowLastType As Long

Dim l_ColumnOfMonth As Long

'We have to start with the cell containing the month.
'Rather than reading row by row, you'd be better off
'reading a whole block at a time.

'Your big problem will be telling WHERE the cell containing
'that month is and for that reason I think you need to seriously
'look at WHY the data is in the format that it is and whether
'you can actually use a much more structured data source.

'For now though let's pretend that you have some magic way of knowing
'where the range is and assign it to a range variable.

'ActiveSheet is a reference to the active worksheet but just as you
'can use a range variable to store a reference to a range,
'you can use a worksheet variable to store a reference to a worksheet
'(even one which is not the active sheet) if you want to.
'I'm only using ActiveSheet for convenience.

'You need to use the Set statement because you're assigning an object.

Set rng_Month = ActiveSheet.Range("C2")

'Ranges have properties like their column number.
'We already know the column number for this range but let's
'assume that we don't in a more general solution.

l_ColumnOfMonth = rng_Month.Column

'Now let's check that the range is valid.
'Don't worry about what the number means,
'just look at the error description.
'If this is True then there must be something wrong with the range.

If l_ColumnOfMonth < 2 Then
    Err.Raise vbObjectError + 20000, , "There are no columns to the left of the month. " _
     & "The range is invalid."
End If

'Now let's find out where the last Type entry occurs in the current
'block. We go up from the bottom of the column to do that.

'In this case we're passing the row and column to the Cells
'property. This defines a range for us representing the bottom
'of the Type column. Using End(xlUp) is the same as pressing the
'[End] key then the [Up arrow] key. It takes us to the last
'populated row, which we read the .Row property of.

l_RowLastType = ActiveSheet.Cells( _
 ActiveSheet.Rows.Count, l_ColumnOfMonth).End(xlUp).Row

'If this is the same as the Month's own row, there's no data
'in that block.

If l_RowLastType = rng_Month.Row Then
    Err.Raise vbObjectError + 20000, , "There are no Type entries in this block. "
End If

'So we've checked that the range looks OK.
'Before we proceed, let's store the month for this block.
'We just get the Value property of the range.
s_Month = rng_Month.Value

'We know that the first product should be 3 rows down and
'one row to the left of the month, so let's just keep looping
'through and reading the values for each row in the block
'until we reach the end of it. We know the end because
'we have its row stored in the l_RowLastType variable.

Set rng_Data = rng_Month.Offset(3, -1)

'Let's get the name of the first product.
s_Product = rng_Data.Value

'If that's nothing, there's a problem.
If s_Product = "" Then
    Err.Raise vbObjectError + 20000, , "No valid product in the expected location. "
End If

'Now let's loop through each row.
For l_RowCurrent = rng_Month.Row + 3 To l_RowLastType

    'Let's look at another way that we can get a reference to
    'a range; by using the Cells property of the sheet.
    'For that we specify the row number and column number.

    Set rng_Data = ActiveSheet.Cells(l_RowCurrent, rng_Month.Column - 1)

    'We know that there won't be a product on each row,
    'so if there isn't one we just use the previous one.
    'Otherwise we assign the new product.

    If rng_Data.Value <> "" Then
        s_Product = rng_Data.Value
    End If

    'Now let's get the type, which is offset 0 rows, 1 column
    'to the right of the product.
    s_Type = rng_Data.Offset(0, 1)

    'If that's a blank cell (like row 8 in your
    'second example we won't do anything else.
    'We only proceed if it's populated.

    If s_Type <> "" Then
        s_Value = rng_Data.Offset(0, 2)

        'Now at this point you have gathered all of your values
        'into variables, and can feed them to your recordset.
        'In this case though we'll just output
        'a messagebox.

        MsgBox "Row " & rng_Data.Row & " is for month " & s_Month _
         & ", product " & s_Product & ", Type " & s_Type _
         & ", Value " & s_Value

    End If

Next

ExitPoint:

On Error Resume Next
Set rng_Month = Nothing
On Error GoTo 0

Exit Sub

ErrorHandler:

MsgBox "Error " & Err.Number & vbCrLf & Err.Description

Resume ExitPoint

End Sub