В большом файле, который я получаю пунктуально, я ищу реорганизацию данных в новом листе файла Excel.
Поэтому я ищу определенные c имена заголовков и переименовываю их и копирую данные или выполняю более сложные операции.
В более простом случае я переименовываю только столбцы. Я ищу столбец с именем «Spe c A» и переименовываю его в «Nabou»
. В более сложном случае я создаю новый столбец путем объединения столбцов. Однако, основываясь на том, присутствует ли информация в других столбцах или нет, я добавляю специальный текст c, который может изменяться в различных случаях. Например, я объединяю несколько столбцов «nup», «nap» и добавляю «WAGA» для строк со значениями, расположенными ниже некоторых указанных c заголовков, и добавляю «CIOCOLATO» для строк без значений, находящихся в этих же заголовки.
Два возможных результата:
nup_nap_WAGA_Snip (для случаев, когда заданные * строки 1060 * имеют значения ниже)
nup_nap_CIOCOLATO_Snip (для случаев, когда строки ниже указанных строк c не имеют значений)
В худшем случае в этом же файле я создаю новые столбцы, объединяя эти столбцы , но я также добавляю указанный c номер в некоторых случаях.
Чтобы узнать число, которое я увеличиваю, мне нужно посмотреть другой exel-файл (другой лист), чтобы добавить указанный c вход в приращении, которое должно быть приращением на основе указанного c условия.
Например, у меня был бы такой результат. «003» основан на проверке другой рабочей книги, которая будет искать строки ниже указанного c заголовка для термина «салат» и добавлять «003», когда после «салат» будет найдено «002»:
Lettuce003_SDS_FSGTEGT Cake0049_SDEWF_TGEGT Birthday004_FEGGE_GTEG
Вот файлы примеров. Для простоты я не добавляю вторую рабочую таблицу, в которой я бы хотел увеличить число в выходном файле на основе сравнения информации в исходной рабочей таблице и этой рабочей таблице:
Вот исходный файл :
Вот выходной файл:
Здесь мой текущий результат ... с макросом, который далек от того, что я пытаюсь сделать
Вот код:
Option Explicit
Sub Snouba()
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 Object
Set headers = CreateObject("Scripting.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("Nabou", "Wurp", "Scope 1", "Scope 2", "Scope 3”, "Scope 4", "NipandNup")
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 Object
Set result = CreateObject("Scripting.Dictionary")
Dim i
For i = 1 To UBound(data, 1)
Select Case True
Case _
data(i, headers("NipandNup")) = "Nip"
MsgBox "Empty row"
Exit For
Case _
result(result.Count) = "Nip"
Case Else
result(result.Count) = "Nup"
End Select
Select Case True
Case _
data(i, headers("Nabou")) = "" Or _
data(i, headers(""Wurp")) = "" Or _
data(i, headers("NipandNup")) = ""
MsgBox "Empty row"
Exit For
Case _
data(i, headers("Scope 1")) = "" And _
data(i, headers("Scope 2")) = "" And _
data(i, headers("Scope 3")) = "" And _
data(i, headers("Scope 4")) = ""
result(result.Count) = _
data(i, headers("Nabou")) & _
"_Alpha" & _
"_" & data(i, headers("Wurp")) & _
"_" & data(i, headers("NipandNup"))
Case Else
result(result.Count) = _
data(i, headers("Nabou")) & _
"_Alphabet" & _
"_" & data(i, headers("Wurp")) & _
"_" & data(i, headers("NipandNup"))
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
Мне удается успешно переименовать столбцы с этим, но это не копирование столбцов на втором листе, и, очевидно, не их содержимое:
Option Explicit
Sub Changeheadername()
Dim lastCol As Long, idCount As Long, nameCount As Long, headerRow As Long
Dim rng As Range, cel As Range
headerRow = 1 'row number with headers
lastCol = Cells(headerRow, Columns.Count).End(xlToLeft).Column 'last column in header row
idCount = 1
nameCount = 1
Set rng = Sheets("Sheet1").Range(Cells(headerRow, 1), Cells(headerRow, lastCol)) 'header range
For Each cel In rng 'loop through each cell in header
If cel = "Wurp" Then 'check if header is "Wurp"
cel = "Snouba" 'rename
ElseIf cel = "Nabou" Then 'check if header is "Nabou"
cel = "WAGD" 'rename
ElseIf cel = "Scope 1" Then 'check if header is "Scope 1"
cel = "I am an a wise rabbit"
End If
Next cel
End Sub