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

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

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

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

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

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

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

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

(或者可能是 NipNupNoupx、NipNupNoupu...)

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

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

因此结果将是:

目前,我有以下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

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

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