使用1列值作为搜索数组

时间:2015-06-19 07:01:43

标签: excel vba excel-vba

我有一个代码,可以搜索整个工作簿中的各个值。我遇到的问题是我需要输入我单独搜索的所有代码,但代码选择已经包含在工作簿中工作表的单个列中。基本上我想要搜索的是查看此列中的值并将它们用作整个工作簿中的数组。

我的总代码看起来像这样

Sub FMES()

Dim Headers() As String: Headers = Split("FMES CODE,Part No,Part Name,FM ID,Failure Mode & Cause,FMCN,PTR,ETR", ",")

    Worksheets.Add().Name = "FMES"
    Dim wsFMES As Worksheet: Set wsFMES = Sheets("FMES")
    wsFMES.Move after:=Worksheets(Worksheets.Count)
    wsFMES.Cells.Clear

    Application.ScreenUpdating = False

    With wsFMES
        For i = 0 To UBound(Headers)
            .Cells(2, i + 2) = Headers(i)
            .Columns(i + 2).EntireColumn.AutoFit
        Next i
        .Cells(1, 2) = "FMES TABLE"
        .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).MergeCells = True
        .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).HorizontalAlignment = xlCenter
        .Range(.Cells(1, 2), .Cells(2, UBound(Headers) + 2)).Font.Bold = True
    End With

    Dim SourceCell As Range, FirstAdr As String
    Dim RowCounter As Long: RowCounter = 3

    Dim SearchTarget() As String
    SearchTarget = Split("TM-CRIT-PART,TM-U-IFSD-HPT,TM-D-IFSD-HPT,TM-HPT-CBO,TM-HPT2-NGV-BURN-MIN,TM-HPT2-NGV-MAJ,TM-HPT-INTGRTY-LOSS,OIL-FZ2-MINOR LEAK,OIL-FZ2-MAJOR LEAK,FIRE-OIL-ZN2", ",")

    For i = 0 To UBound(SearchTarget)
        If Worksheets.Count > 1 Then
            For j = 1 To Worksheets.Count - 1
            With Sheets(j)
                Set SourceCell = .Columns(8).Find(SearchTarget(i), LookAt:=xlPart, LookIn:=xlValues)
                If Not SourceCell Is Nothing Then
                    FirstAdr = SourceCell.Address
                    Do
                        wsFMES.Cells(RowCounter, 2).Value = SearchTarget(i)
                        wsFMES.Cells(RowCounter, 3).Value = .Cells(3, 10)
                        wsFMES.Cells(RowCounter, 4).Value = .Cells(2, 10)
                        wsFMES.Cells(RowCounter, 5).Value = .Cells(SourceCell.Row, 2).Value
                        For k = 0 To SourceCell.Row - 1
                            If .Cells(SourceCell.Row - k, 3).Value <> "continued." Then
                                wsFMES.Cells(RowCounter, 6).Value = .Cells(SourceCell.Row - k, 3).Value
                                Exit For
                            End If
                        Next k
                        wsFMES.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row, 14).Value


                        Set SourceCell = .Columns(8).FindNext(SourceCell)
                        RowCounter = RowCounter + 1
                    Loop While Not SourceCell Is Nothing And SourceCell.Address <> FirstAdr
                End If
            End With
            Next j
        End If
    Next i


    End Sub

定义搜索条件的部分是

  Dim SearchTarget() As String
    SearchTarget = Split("TM-CRIT-PART,TM-U-IFSD-HPT,TM-D-IFSD-HPT,TM-HPT-CBO,TM-HPT2-NGV-BURN-MIN,TM-HPT2-NGV-MAJ,TM-HPT-INTGRTY-LOSS,OIL-FZ2-MINOR LEAK,OIL-FZ2-MAJOR LEAK,FIRE-OIL-ZN2", ",")

    For i = 0 To UBound(SearchTarget)
        If Worksheets.Count > 1 Then
            For j = 1 To Worksheets.Count - 1
            With Sheets(j)
                Set SourceCell = .Columns(8).Find(SearchTarget(i), 

它正在搜索的代码是TM-CRIT-PART ...等我的问题是有数百个,它们都包含在Cell A4和A397之间的FMES代码的工作表中。有没有办法可以将此单元格范围内的值定义为搜索条件?

1 个答案:

答案 0 :(得分:1)

当将范围传递给不是Object variable的变量时,您可以使用简单的解决方案,您将得到一个二维数组。您的代码中需要进行一些更改。请遵循以下代码:

Dim SearchTarget As Variant         '<<change type, remove brackets
    SearchTarget = Sheets("FMES").Range("A4:A297")  '<<define array 
           'our array is now two dimensional starting with (1,1)

    For i = 1 To UBound(SearchTarget, 1)    '<<change starting point and loop scope
        '...some of your code here
        Set SourceCell = .Columns(8).Find(SearchTarget(i, 1),   '<<changes here

提示!可以将来自单Colum Range的二维数组转换为一维数组。如果需要,请使用Transpose function