Соответствие подмножеству данных

Question

Я заполняю метки элемента управления ActiveX подмножеством данных Excel в VBA. Мой код ранее работал для всей книги Excel, но как только я изменил свой код, чтобы ссылаться только на подмножество данных, вводятся неверные данные.

Вот снимок примера данных. В моем коде столбец 6 = CY и столбец 7 = FY. В настоящее время код заполняет мои метки заголовками столбцов 6 и 7, а не значениями «активных» или «объединенных» проектов.

Как уже упоминалось, я не получаю никаких сообщений об ошибках, но правильные данные не добавляются на мои метки ActiveX. К вашему сведению ... В строке 31 Code1 указано название метки ActiveX.

Private Sub CommandButton1_Click()

    Dim objExcel As Excel.Application
    Dim exWB As Excel.Workbook
    Dim rng As Excel.Range, m, rw As Excel.Range
    Dim num, TableNo, seq As Integer
    Dim ctl As MSForms.Label
    Dim ils As Word.InlineShape
    Dim rngrow As Excel.Range
    Dim active As Excel.Range

    Set objExcel = New Excel.Application
    TableNo = ActiveDocument.Tables.Count
    num = 3
    seq = 1

Set exWB = objExcel.Workbooks.Open("O:\Documents\"Database.csv")
Set rng = exWB.Sheets("Sheet1").Cells

''''Select active projects as subset
    For Each rngrow In rng.Range("A1:L144")
     If rngrow.Columns(8).value = "Active" Or rngrow.Columns(8).value = "Merged" Then
            If active Is Nothing Then
                Set active = rngrow
            Else
                Set active = Union(active, rngrow)
            End If
        End If
    Next rngrow

    m = objExcel.Match(ActiveDocument.Code1.Caption, active.Columns(3), 0)

'' Now, create all ActiveX FY labels and populate with FY Use
Do
    Set ils = ActiveDocument.Tables(num).cell(6, 2).Range.InlineShapes.AddOLEControl(ClassType:="Forms.Label.1")
    Set ctl = ils.OLEFormat.Object
    ctl.Name = "FY" & seq
    If Not IsError(m) Then
    Set rw = rng.Rows(m)
    ctl.Caption = rw.Cells(7).value
    Else
        MsgBox "No match found"
    End If
    seq = seq + 1
    num = num + 1
Loop Until num = TableNo + 1


'' Now, create all ActiveX CY labels and populate with CY
num = 3
seq = 1
Do
    Set ils = ActiveDocument.Tables(num).cell(7, 2).Range.InlineShapes.AddOLEControl(ClassType:="Forms.Label.1")
    Set ctl = ils.OLEFormat.Object
    ctl.Name = "CY" & seq
    If Not IsError(m) Then
    Set rw = rng.Rows(m)
    ctl.Caption = rw.Cells(6).value
    Else
        MsgBox "No match found"
    End If
    seq = seq + 1
    num = num + 1
Loop Until num = TableNo + 1


Set exWB = Nothing

End Sub

Ссылка на мой предыдущий вопрос ниже: Использование данных Excel для создания меток надписей Word Do c в VBA

Answer 1

Это:

For Each rngrow In rng.Range("A1:L144")

будет интерпретироваться как

For Each rngrow In rng.Range("A1:L144").Cells

, поэтому ваш l oop будет A1, B1, C1, ... L1, затем A2, B2 et c.

Похоже, вы имели в виду:

For Each rngrow In rng.Range("A1:L144").Rows

, поэтому rngRow будет A1: L1, затем A2: L2 и др. c.

РЕДАКТИРОВАТЬ - Вы не можете ссылаться на active, используя что-то вроде MsgBox(active.Range ("A2")), так как это многообластный диапазон.

Попробуйте, например, -

For Each rw in active.Rows
    debug.print "Row:" & rw.Row, rw.cells(8).value
Next rw

EDIT2 : попробуйте вместо этого. Не проверено, но я думаю, что это должно работать ОК

Private Sub CommandButton1_Click()

    Dim objExcel As Excel.Application
    Dim exWB As Excel.Workbook
    Dim data, r As Long, resRow As Long, seq As Long, num As Long
    Dim doc As Document

    'get the Excel data as a 2D array
    Set objExcel = New Excel.Application
    Set exWB = objExcel.Workbooks.Open("O:\Documents\Database.csv")
    data = exWB.Sheets("Sheet1").Range("A1:L144").Value '>> 2D array
    exWB.Close False
    objExcel.Quit

    resRow = 0
    'find the first matching row, if any
    For r = 1 To UBound(data, 1)
        If (data(r, 8) = "Active" Or data(r, 8) = "Merged") And _
                              data(r, 3) = doc.Code1.Caption Then
            resRow = r        'this is the row we want
            Exit Sub          'done looking
        End If
    Next r

    Set doc = ActiveDocument
    seq = 1
    For num = 3 To doc.Tables.Count
        With doc.Tables(num)
            AddLabel .Cell(6, 2), "FY" & seq, IIf(resRow > 0, data(resRow, 7), "Not found")
            AddLabel .Cell(7, 2), "CY" & seq, IIf(resRow > 0, data(resRow, 6), "Not found")
        End With
        seq = seq + 1
    Next num

End Sub

'add a label to a cell, set its name and caption
Sub AddLabel(theCell As Cell, theName As String, theCaption As String)
    Dim ils As InlineShape, ctl As MSForms.Label
    Set ils = theCell.Range.InlineShapes.AddOLEControl(ClassType:="Forms.Label.1")
    Set ctl = ils.OLEFormat.Object
    ctl.Name = theName
    ctl.Caption = theCaption
End Sub