У меня есть файл, который изменяется через VBA. Он объединяет три столбца на листе, чтобы создать имя.
Однако для создания новых данных необходимо объединить другую информацию. Данные необходимо создавать, извлекая что-то из данных в другой книге.
В столбце scpecifi c, имя которого всегда одно и то же (но местоположение которого может измениться, однако на листе), макрос необходим искать конкретную c информацию. Возможны четыре варианта.
Как только эта возможность определена, как только термин соответствует одному из этих четырех, VBA должен увеличить число в конце термина в рабочей книге, необходимо увеличить.
В первой рабочей книге структура выглядит следующим образом:
Для «Noup» существует четыре случая: Noupx, Noupy, Noupu, Noupa
- VBA объединяет: NipNupNoupa
(или, возможно, NipNupNoupx, NipNupNoupu ...)
Тогда VBA должен go в другой книге, найти либо термин «Noupa», «Noupu», «Noupx», «Noupy».
Для каждого из них должен быть идентифицирован конкретный c номер, следующий после «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
Столбцы сгруппированы с помощью этого макроса, но теперь мне нужно посмотреть на другой лист, инкремент различных Noupu, Noupy и т. д. c и т.