获取 ID 序列中的第一个和最后一个数字以及产品名称并显示在另一个工作表中

Question

我有一个工作表“Blanco List”，显示来自 35 个工作表的组合数据，条件是列范围“A:F”和 x 行。当我更新该表时，行号可能会有所不同。我需要的是搜索“A”列中的每个 ID 序列和“B”列中每个产品的名称，并在序列中查找第一个和最后一个 ID 号并获取属于该 ID 的产品名称。然后，在工作表“ReadyTG”中显示结果。 我尝试使用 Excel 函数 Min、Max 和 VlookUp，但每次行号更改时我都需要扩展公式范围。所以我需要一些 VBA 解决方案。 Screenshoot of wanted result
工作簿示例在此链接中：https://easyupload.io/o648lb

提前致谢！

Answer 1

首先生成一个数据透视表，然后获取所有唯一的序列号。 运行此 VBA 以生成公式并从中重新获取值。每次值更改时，您都必须运行 VBA 脚本。

Sheets("ReadyTG").Select
For i = 3 To 10 'row
    Range("L" & i).FormulaArray = "=MIN(IF('Blanko List'!C7=RC[-1],'Blanko List'!C8))"
    Range("L" & i).Value = Range("L" & i).Value
    Range("M" & i).FormulaArray = "=MAX(IF('Blanko List'!C7=RC[-2],'Blanko List'!C8))"
    Range("M" & i).Value = Range("M" & i).Value
Next i

Answer 2

如果由于 Excel 不断评估数千个公式而导致性能问题，您可以使用以下命令中断自动公式计算（第一行）并在保存时计算所有内容（第二行）。

Application.Calculation = xlCalculationManual
Application.CalculateBeforeSave = True

---

如果您仍希望使用 VBA 计算最大值和最小值，考虑到名称位于单元格 J3 及以下：

Sub MinMax()
    Dim oNameCell As Cell
    Dim oCell As Cell
    Dim No As Long

    For Each oNameCell in Range("J3", Range("J3").End(xlDown))
        For Each oCell in Range("B2", Range("B2").End(xlDown))
            If oNameCell = oCell Then
                No = Split(oNameCell.Offset(, -1), "-")(1)
                If No < oNameCell.Offset(, 1) Then _
                    oNameCell.Offset(, 1) = No
                If No > oNameCell.Offset(, 2) Then _
                    oNameCell.Offset(, 2) = No
            End If
        Next oCell
    Next oSNCell
End Sub

当然，每次输入新数据时，您都必须重新运行此宏。

也许见Assign a macro to a button。

Answer 3

这不是一个正确的答案，但我用 Macro recored 编写了代码，它对我有用。如果有人知道如何使这段代码更简单，我很高兴听到它。这东西确实需要优化。

Sub Macro6()

'call macro8 to prevent any calculations on sheet "ReadyTG" and to clear old 
values
Call Macro8


'finding last row in sheet "Blanko List"
Dim lRow As Long, sht As Worksheet
Set sht = Worksheets("Blanko List")
lRow = sht.Range("A2").CurrentRegion.Rows.Count

'Macro recored while doing option from Data tab > Text To Columns, to separate 
'value from column A
'into 2 part, value before "-" and after "-"

sht.Range("A2", sht.Range("A2" & lRow)).Select
Selection.TextToColumns Destination:=Range("G2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), 
  TrailingMinusNumbers:=True
    
 'Advance fileter to remove duplicates from column "G"
 'so that Hlookup function can do its job

 sht.Range("G2", sht.Range("G2" & lRow)).Select
 sht.Range("G2", sht.Range("G2" & lRow)).AdvancedFilter Action:=xlFilterCopy, 
 CopyToRange:=Range("I2" _
    ), Unique:=True
    
    'There is a problem in range or something with AdvanceFilter, it returns 2 values of same Product name in first 2 rows
    Columns("I:I").Select
ActiveSheet.Range("$I$2:$I$58").Removeduplicates Columns:=1, Header:=xlNo

End Sub
 '-----------------------------------------------------------------------------




  Sub Macro7()
 'Return name and serial number in columns A and B from sheet "Blanko List"
 ' and runs array forumula  to get first and last number of ID sequince
 'also it autofill rows with funcitons up to 60 rows, because i don t know the 
 last row

 Range("A2").Select
 ActiveCell.FormulaR1C1 = _
    "=IFNA(VLOOKUP(RC[1]&""*"",'Blanko List'!C:C[1],2,FALSE),"""")"
 Range("B2").Select
 ActiveCell.FormulaR1C1 = _
    "=IFNA(HLOOKUP(R1C2,'Blanko List'!C[7],ROW(RC),FALSE),"""")"
 Range("C2").Select
 Selection.FormulaArray = _
    "=MIN(IF('Blanko List'!C[4]=RC[-1],'Blanko List'!C[5]))"
 Range("D2").Select
 Selection.FormulaArray = "=MAX(('Blanko List'!C[3]=RC[-2])*'Blanko List'!C[4])"
 Range("A2:D2").Select
 Selection.AutoFill Destination:=Range("A2:D59"), Type:=xlFillDefault
 Range("A2:D59").Select


  End Sub
 '-------------------------------------------------------

 Sub Macro8()
 'clears all existing formulas and values in target sheet for better performance
 'calculating time before this 3 minutes

 ThisWorkbook.Worksheets("ReadyTG").Select
 Rows("2:160").Select
 Selection.Delete Shift:=xlUp
 ThisWorkbook.Worksheets("Blanko List").Select

 End Sub

Answer 4

您可以使用Power Query 获得所需的输出，在 Windows Excel 2010+ 和 Office 365 Excel 中可用

• 选择原始表格中的某个单元格
• Data => Get&Transform => From Table/Range
• 当 PQ UI 打开时，导航到Home => Advanced Editor
• 记下代码第 2 行中的表名。
• 用下面的M-Code替换现有代码
• 将粘贴代码的第 2 行中的表名更改为您的“真实”表名
• 检查所有 cmets 以及 Applied Steps 窗口，以更好地了解算法和步骤

M 码

let

//change table name in next line to actual table name in your workbook
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

//set the data types
    #"Changed Type" = Table.TransformColumnTypes(Source,{
        {"Serial Number", type text}, {"Name", type text}, {"Quantity", Int64.Type}, 
        {"ME/JM", type text}, {"Status", type text}, {"Date of entry", type date}},
         "en-150"),

//split the serial number column on the delimiter
//Only the first delimiter since I don't know what to do with sn's with multiple hyphens
    #"Split Column by Delimiter" = Table.SplitColumn(#"Changed Type", "Serial Number", 
        Splitter.SplitTextByDelimiter("-", QuoteStyle.Csv), {"Serial Number", "Serial Number.2"}),

//set data types to numbers so we can get Min and Max
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{
        {"Serial Number", Int64.Type}, {"Serial Number.2", Int64.Type}}),

//Group by Name and main serial number
//extract the min and max of part2 of the serial number
    #"Grouped Rows" = Table.Group(#"Changed Type1", {"Name", "Serial Number"}, {
        {"First", each List.Min([Serial Number.2]), Int64.Type}, 
        {"Last", each List.Max([Serial Number.2]), Int64.Type}})
in
    #"Grouped Rows"

上传文件中数据的结果