获取高于特定值的值，并将其加载到下面的其他值中。

Question

这个问题的题目听起来像是个难题，所以让我把它简化一下。

A列

Item_1

Sub_Items

Sub_Item_1.1

Sub_Item_1.2

Sub_Item_1.3

Item_2

Sub_Items

Sub_Item_2.1

Sub_Item_2.2

Sub_Item_2.3

我试图通过一个公式或宏来实现的是，对于"Sub_Items“下面的每个单元格，将项目号放在"Sub_Items”之后，直到它达到新的项目号为止。

期望输出

A栏

Item_1 

Sub_Items

Sub_Item_1.1 -商品-价格- Item_1

Sub_Item_1.2 -商品-价格- Item_1

Sub_Item_1.3 成品率成品率  Item_1

Item_2 

Sub_Items 

Sub_Item_2.1 成品率成品率 Item_2

Sub_Item_2.2 成品率成品率 Item_2

Sub_Item_2.3 成品率成品率 Item_2

针对Item_1和Sub_Items的值也可以是空的，这很好，但是我试图获得对应的子项的每个项目号。任何帮助都是非常感谢的。非常感谢。

Answer 1

试试这个：

Sub test()
Dim itemTitle As String
Dim itemNo As Integer
Dim lastRow As Long
Dim cel As Range, loopRange As Range
Dim ws As Worksheet

Set ws = ActiveSheet

itemTitle = "Item_" 'Your items will have at least this amount, then that starts.

Dim currentItem As String

With ws
    lastRow = .UsedRange.Rows.Count
    Set loopRange = .Range(.Cells(1, 1), .Cells(lastRow, 1))

    For Each cel In loopRange
        cel.Select
        If Left(cel.Value, 5) = itemTitle Then
            currentItem = cel.Value
        End If
        cel.Offset(0, 1).Value = currentItem
    Next cel
End With

End Sub

注意:我假设您的项目将以"Item_“开头。如果情况并非如此，只需将itemTitle定义更改为任何可能的定义。这也适用于任何数量的项目，无论您是否知道有多少。

编辑:好的，因为您的项目不是"Item_1"，所以我有一个新代码：

Sub test_with_Array()
Dim itemTitle As String
Dim itemNo As Integer
Dim lastRow As Long
Dim cel As Range, loopRange As Range
Dim ws As Worksheet, itemNoWS As Worksheet
Dim itemNumbers() As Variant

Application.ScreenUpdating = False
Application.Calculation = xlManual

Set ws = ActiveSheet
Set itemNoWS = Sheets("Item Numbers") 'Change this to whatever the sheet is that has your unique IDs

'Now, let's find out how many unique Item IDs you have.  I am assuming they're all listed in Column A without any blank spaces.
Dim numberOfIDs As Integer
With itemNoWS
numberOfIDs = Evaluate(WorksheetFunction.CountA(.Range(.Cells(1, 1), .Cells(.Cells(1, 1).End(xlDown).Row, 1))))
Debug.Print "There are " & numberOfIDs & " unique IDs."
ReDim itemNumbers(1 To numberOfIDs) 'Set the array size to fit the number of unique IDs
itemNumbers() = .Range(.Cells(1, 1), .Cells(.Cells(1, 1).End(xlDown).Row, 1))
End With

Dim i As Integer
For i = LBound(itemNumbers) To UBound(itemNumbers) 'This just checks to make sure we have the IDs
    Debug.Print itemNumbers(i, 1)
Next i

Dim currentItem As String
ws.Activate
With ws 'Now, let's add the Item Numbers by their respective entry
    lastRow = .UsedRange.Rows.Count
    Set loopRange = .Range(.Cells(1, 1), .Cells(lastRow, 1))

    For Each cel In loopRange
        cel.Select
        For i = LBound(itemNumbers) To UBound(itemNumbers) 'Loop through your array of Item numbers, looking for a match
            Debug.Print "Looking for " & itemNumbers(i, 1) & " in string " & cel.Value
            Debug.Print StrComp(cel.Value, itemNumbers(i, 1))
            If StrComp(cel.Value, itemNumbers(i, 1)) = 0 Then
                currentItem = cel.Value
            End If
            cel.Offset(0, 1).Value = currentItem
        Next i
    Next cel
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

您提到您确实获得了一个唯一ID的列表。如果您将这些内容放在文档中的第二个工作表中，将其称为“项目编号”(或其他一些东西，只需确保更改代码以反映它)，并将这些项列在A列中的连续列表中，则上述内容应该有效。如果你有任何调整/错误，请告诉我。

编辑2：

根据您的说明，我们可以使用"Sub_Items“作为分隔符，请尝试下面的代码：

Sub test()
Dim itemNo As Integer
Dim lastRow As Long
Dim cel As Range, loopRange As Range
Dim ws As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set ws = ActiveSheet

Dim currentItem As String

With ws
    lastRow = .UsedRange.Rows.Count

    Set loopRange = .Range(.Cells(1, 1), .Cells(lastRow, 1))

    For Each cel In loopRange
        cel.Select
        If cel.Value = "Sub_Items" Then

            currentItem = cel.Offset(-1, 0).Value
            cel.Offset(-1, 1).Value = currentItem
        End If
        cel.Offset(0, 1).Value = currentItem
    Next cel
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

META:我不确定有多少编辑/代码添加是可以的，所以如果我能使这个帖子更好地为这样的最佳实践，就让我知道！