搜索以连接列并在两者之间从另一个工作簿中选择额外的数量，该数量应递增

Question

我有一个文件是通过VBA修改的。它连接 sheet 中的三列以创建名称。

但是，需要连接另一个信息来创建新数据。需要通过从另一个工作簿中的数据推导某些内容来创建数据。

在特定列中，始终具有相同的名称（但其位置可以更改，但是在 sheet 中），宏需要查找特定信息。可能有四种可能。

一旦确定了这种可能性，一旦术语与这四个中的任何一个相匹配，VBA 应该递增工作簿中术语末尾的数字需要递增。

第一个工作簿中的结构如下：

Nip Nup Noupx

对于"Noup"有四种情况：Noupx, Noupy, Noupu, Noupa

VBA 连接：NipNupNoupa

（或者可能是 NipNupNoupx、NipNupNoupu...）

然后 VBA 应该放在另一个工作簿中，查找术语 "Noupa"、"Noupu"、"Noupx"、"Noupy".

对于这些中的每一个，在 "Noupa"（或其他）之后的特定数字应该被识别并且应该通过添加“+1”来增加它。

因此结果将是：

Noupa002（由 Noupa001 鉴定结果）
Noupu034（由Noupu033鉴定得到）

目前，我有以下VBA代码，我不知道如何在另一个工作簿中查找数据并递增它。

Sub TralaNome()

    Const q = """"

    ' get source data table from sheet 1
    With ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion

   ' check if data exists
        If .Rows.Count < 2 Or .Columns.Count < 2 Then
            MsgBox "No data table"
            Exit Sub
        End If

   ' retrieve headers name and column numbers dictionary
        Dim headers As Dictionary
        Set headers = New Dictionary
        Dim headCell
        For Each headCell In .Rows(1).Cells
            headers(headCell.Value) = headers.Count + 1
        Next

   ' check mandatory headers

        For Each headCell In Array(("Costumer", "ID", "Zone“,  "Product Quali", "Spec A", "Spec B", "Spec_C", "Spec_D", "Spec_1",  " Spec_2", " Spec_3", " Spec_4", " Spec_5", " Spec_6", " Spec_7", "Chiavetta", "Tipo_di _prodotto",  "Unicorno_Cioccolato", “cacao tree“)
            If Not headers.Exists(headCell) Then
                MsgBox "Header '" & headCell & "' doesn't exists"
                Exit Sub
            End If
        Next
        Dim data

 ' retrieve table data
        data = .Resize(.Rows.Count - 1).Offset(1).Value
    End With

   ' process each row in table data
    Dim result As Dictionary
    Set result = New Dictionary
    Dim i
    For i = 1 To UBound(data, 1)
                    MsgBox "Empty row"
                    Exit For
                    result(result.Count) = _
                        q & "ID " & data(i, headers("ID ")) & _
                        q & " Tipo_di _prodotto " & data(i, headers("Tipo_di _prodotto")) & _
                        q & " cacao tree " & data(i, headers("Nupu")) & _
                        q
        End Select

    Next

    ' output result data to sheet 2
    If result.Count = 0 Then
        MsgBox "No result data for output"
        Exit Sub
    End If
    With ThisWorkbook.Sheets(2)
        .Cells.Delete
        .Cells(1, 1).Resize(result.Count).Value = _
            WorksheetFunction.Transpose(result.Items())
    End With
    MsgBox "Completed"


End Sub

列是通过这个宏分组的，但我现在需要查看其他工作sheet，增加各种 Noupu、Noupy 等等...

我认为应该使用那种 VBA 来增加增量值：

Function GetLastRowWithData(WorksSheetNoupa As Worksheet, Optional NoupaLastCol As Long) As Long
    Dim lCol, lRow, lMaxRow As Long
    If NoupaLastCol = 0 Then
        NoupaLastCol = wsSheet.Columns.Count
    End If
    lMaxRow = 0
    For lCol = NoupaLastCol To 1 Step -1
        lRow = wsSheet.Cells(wsSheet.Rows.Count, lCol).End(xlUp).Row
        If lRow > lMaxRow Then
            lMaxRow = lRow
        End If
    Next
    GetLastRowWithData = lMaxRow
End Function

Answer 1

（抱歉，这可能应该是一个评论，但我还没有足够的声誉）。但是，即使没有详细检查您的代码，我也会在 for 循环中间看到一个 exit for 而没有 If 以避免在某些情况下出现这种情况。据推测，这意味着循环中该行下方的任何内容都永远不会完成 - 除了第一个实例之外，循环也没有任何好处。（这是注释 'process each row in table data 的循环）

你试过运行这一步吗？（打开测试数据集进入 VBEditor，然后按 F8 或调试工具栏中的 'step into' 按钮）

搜索以连接列并在两者之间从另一个工作簿中选择额外的数量，该数量应递增

Searching to concatenate columns and in between pick additional amount from another workbook, that shall be incremented

excel

vba

increment

conditional-statements