搜索以连接列并在两者之间从另一个工作簿中选择额外的数量,该数量应递增
Searching to concatenate columns and in between pick additional amount from another workbook, that shall be incremented
我有一个文件是通过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
(抱歉,这可能应该是一个评论,但我还没有足够的声誉)。
但是,即使没有详细检查您的代码,我也会在 for 循环中间看到一个 exit for
而没有 If
以避免在某些情况下出现这种情况。据推测,这意味着循环中该行下方的任何内容都永远不会完成 - 除了第一个实例之外,循环也没有任何好处。 (这是注释 'process each row in table data
的循环)
你试过运行这一步吗? (打开测试数据集进入 VBEditor,然后按 F8 或调试工具栏中的 'step into' 按钮)
我有一个文件是通过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
(抱歉,这可能应该是一个评论,但我还没有足够的声誉)。
但是,即使没有详细检查您的代码,我也会在 for 循环中间看到一个 exit for
而没有 If
以避免在某些情况下出现这种情况。据推测,这意味着循环中该行下方的任何内容都永远不会完成 - 除了第一个实例之外,循环也没有任何好处。 (这是注释 'process each row in table data
的循环)
你试过运行这一步吗? (打开测试数据集进入 VBEditor,然后按 F8 或调试工具栏中的 'step into' 按钮)