Question

这是Sheet1初始状态的一个简单示例：

 |   A  |   B  |   C  |   D  |   E  |
1|   101|   102|   103|   104|   105|
2|      |      |      |      |      |
3|      |      |      |      |      |

这是Sheet2中数据的一个简单示例：

 |   A  |   B  |   C  |   D  |   E  |   F  |   G  |
1|Name1 |Name2 |Name3 |Name4 |Name5 |Name6 |Name7 |
2|101abc|106abc|107abc|104zyx|106def|102abc|101def|
3|106ghi|102def|104wvu|101ghi|107def|105zyx|104tsr|
4|101jkl|102ghi|101mno|101pqr|104qpo|106jkl|102jkl|
5|102mno|102pqr|104nml|106mno|101stu|104kji|102stu|

我正在尝试编写一个宏，它将从Sheet2中提取数据并将其添加到Sheet1中以创建：

 |   A  |   B  |   C  |   D  |   E  |
1|   101|   102|   103|   104|   105|
2|101abc|102abc|      |104zyx|105zyx|
3|101def|102def|      |104wvu|      |
4|101ghi|102ghi|      |104tsr|      |
5|101jkl|102jkl|      |104qpo|      |
6|101mno|102mno|      |104nml|      |
7|101pqr|102pqr|      |104kji|      |
8|101stu|102stu|      |      |      |

Sheet1的第1行包含标识我想要提取的值的关键字。

Sheet2的第1行包含与当前宏无关的标题。其余行包含以关键字开头的值。我试图从Sheet2中提取匹配Sheet1中每个关键字的值，并在关键字下列出它们。

如果有人帮助我，那将是很棒的。

Answer 1

我已经从您的评论中重写了您的问题，因为重要的是问题很清楚并且与答案相符。发布时请确保以后的任何问题都清楚;不要依赖任何愿意挑逗你的人。

Option Explicit
Sub Report()

  ' Introduction to Version 1

  ' * I have set row 1 of Sheet1 to 101, 102, 103, 104 and 105
  ' * I have scattered the values 101, 102, 104 and 105 across Sheet2
  '   starting from cell A2.
  ' * For each value in row 1 of Sheet1, this macro either:
  '    * Reports it cannot find the value in Sheet2.
  '    * Lists the addresses of the cells containing the values.
  ' * I do not understand what you want to do when you discover cell XN
  '   contains a value from row 1 of Sheet1 so I have stored the addresses
  '   in a collection.  You may wish to keep the collection so you can
  '   process all the occurrences of a value at the same time (as I do)
  '   or you may discard the collection and process each value as you find
  '   it.

  ' Introduction to Version 2 which was created from version 1 after clarification
  ' of the contents of Sheet2 and clairification of the required output.

  ' * The appearances of Sheet1 and Sheet2 are now as shown in the question.
  ' * The values found (rather than the addresses) are now stored in the
  '   collection.
  ' * At the end of each repeat of the inner loop, the values found are now
  '   written to Sheet1 under the appropriate header

  Dim ColSht1Crnt As Long
  Dim InxL As Long
  Dim Locations As New Collection
  Dim RngFirst As Range
  Dim RngCrnt As Range
  Dim RowSht1Crnt As Long
  Dim SearchValue As String
  Dim Wsht1 As Worksheet
  Dim Wsht2 As Worksheet

  Set Wsht1 = Worksheets("Sheet1")
  Set Wsht2 = Worksheets("Sheet2")

  ' Clear any data in Sheet1 stored by a previous run of this macro
  Wsht1.Rows("2:" & Rows.Count).Delete

  ColSht1Crnt = 1

  ' Each repeat of this outer loop processing a column of Sheet1. It
  ' finishes when it finds an empty column in row 1.
  Do While Wsht1.Cells(1, ColSht1Crnt).Value <> ""

    SearchValue = Wsht1.Cells(1, ColSht1Crnt).Value

    With Wsht2

      ' The value for After means the first cell examined is A2. The values for
      ' SearchOrder and SearchDirection means the search down the sheet from left
      ' to right.
      ' V1 Search for SearchValue.  V2 Search for anything starting with SearchValue
      Set RngFirst = .Cells.Find(What:=SearchValue & "*", After:=.Cells(1, Columns.Count), _
                                 LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                 SearchDirection:=xlNext)

      If RngFirst Is Nothing Then
        'Debug.Print "There are no occurrences of [" & SearchValue & "]" & " in Sheet2"
      Else
        ' There is at least one occurence of SearchValue

        ' V1 Delete any locations recorded for the last SearchValue
        ' V2 Delete any values recorded for the last SearchValue
        Do While Locations.Count > 0
          Locations.Remove (1)
        Loop

        Set RngCrnt = RngFirst

        ' V1 Each repeat of this loop records the location of an occurrence of SearchValue
        ' V2 Each repeat of this loop records a value found that starts with SearchValue
        Do While True

          ' V1 Record location of SearchValue
          'Locations.Add (Replace(RngCrnt.Address, "$", ""))
          ' V2 Record value of cell starting SearchValue
          Locations.Add (RngCrnt.Value)

          Set RngCrnt = .Cells.FindNext(After:=RngCrnt)

          If RngCrnt.Address = RngFirst.Address Then
            ' Search has looped and has found first occurrence again
            Exit Do
          End If

        Loop

        ' V1 Debug.Print "[" & SearchValue & "]" & " has been found in Sheet2 in the following cells:";
        ' V1 For InxL = 1 To Locations.Count
        ' V1 Debug.Print " " & Locations(InxL);
        ' V1 Next
        ' V1 Debug.Print
        ' V2 Store values found under heading
        RowSht1Crnt = 2
        With Wsht1
          For InxL = 1 To Locations.Count
            .Cells(RowSht1Crnt, ColSht1Crnt).Value = Locations(InxL)
            RowSht1Crnt = RowSht1Crnt + 1
          Next
        End With

      End If

    End With

    ColSht1Crnt = ColSht1Crnt + 1
  Loop

End Sub

水平获取数据

1 个答案: