Excel宏，按行搜索返回下一个单元格的值

弗拉孔

我有这个宏已经在工作：

    Sub ListSheetsValuesAreOn()
  Dim X As Long, Data As Variant, Uniques As String, SH As Worksheet, NewSH As Worksheet
  With CreateObject("Scripting.Dictionary")
    For Each SH In Worksheets
      Data = Application.Transpose(SH.Range("C23", SH.Cells(Rows.Count, "C").End(xlUp)))
      For X = 1 To UBound(Data)
        If IsEmpty(.Item(Data(X))) Then
          .Item(Data(X)) = Data(X) & "|" & SH.Name
        ElseIf Data(X) = Split(.Item(Data(X)), "|")(0) And _
               Not .Item(Data(X)) Like "*|*" & SH.Name & "*" Then
          .Item(Data(X)) = .Item(Data(X)) & ", " & SH.Name
        End If
      Next
    Next
    Sheets.Add After:=Sheets(Sheets.Count)
    Set NewSH = ActiveSheet
    NewSH.Range("A1").Resize(.Count) = Application.Transpose(.Items)
  End With
  NewSH.Name = "Result Sheet"
  NewSH.Columns("A").TextToColumns , xlDelimited, , , 0, 0, 0, 0, 1, "|"
  NewSH.Columns("A:B").AutoFit
End Sub

该脚本的作用是：读取C列中的值，并搜索所有工作簿以查找这些值。返回值和找到它们的工作表。但是我想返回的不是C中的每个值，而是D列中的下一个值。示例：

Sheets 1...n                                   Expected output (new sheet)

  C     |    D                                   A        |       B

  item 1|description of item 1       description of item 1|1,4,6

  item 2|description of item 2       description of item 2|3,7,11,12

   ...  | ....                           ....             |   .....

  item m|description of item m       description of item m| 5,9,15,24

Aggelos SunDance Troulakis

请试试这个：

Sub Answer()

   Dim dict As Object
   Dim Data As Variant
   Dim ws As Worksheet
   Dim rng As Range



   Set dict = CreateObject("Scripting.Dictionary")
   With dict
      For Each SH In Worksheets
         Data = Application.Transpose(SH.Range("C23", SH.Cells(Rows.Count, "D").End(xlUp)))
         For X = LBound(Data, 2) To UBound(Data, 2)

            If IsEmpty(.Item(Data(1, X))) Then
               .Item(Data(1, X)) = Data(2, X) + "|" + SH.Name
               '.Item(Data(2, X)) = .Item(Data(1, X))
            ElseIf Split((dict.Item(Data(1, X))), "|")(0) = Split((Data(2, X)), "|")(0) Then
               .Item(Data(1, X)) = .Item(Data(1, X)) + ", " + SH.Name
            End If
         Next X
    Next
    Sheets.Add After:=Sheets(Sheets.Count)
    Set NewSH = ActiveSheet
    NewSH.Range("A1").Resize(.Count) = Application.Transpose(.Items)

  End With
  NewSH.Name = "Result Sheet"
  NewSH.Columns("A").TextToColumns , xlDelimited, , , 0, 0, 0, 0, 1, "|"
  NewSH.Columns("A:B").AutoFit
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。