水平获取数据

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