Это отдельный вопрос, вытекающий из этого сообщения: Как использовать имя файла Excel для изменения столбца ячеек?
Я заметил, что в коде последнего поста он ссылался на определенные ячейки (J2, K2). Однако при использовании кода я столкнулся с ошибкой при изменении столбцов. Итак, теперь я ищу способ изменить приведенный ниже код, чтобы использовать имена столбцов заголовков для заполнения второго столбца вместо ссылки на конкретные ячейки. Я думаю, что единственная строка, которую действительно нужно настроить, - это строка myRng, но я предоставлю весь код, который я пытаюсь использовать для справки.
Если вы не читаете другой пост, я опишу проблему. Я пытаюсь заполнить второй столбец (имя + тип) на основе столбца "имя" и имени файла. Когда я ссылался на строку K или J в коде, все работало нормально, но когда я загружаю другой файл и позиции столбцов меняются, все портится.
Мне нужно заполнить 2-й столбец (имя + тип), чтобы он был точно таким же числом или строками, что и 1-й столбец (имя), поэтому я использую формулу Range ("K2: K" и lastCell).
Есть ли способ сделать это?
Текущий код попытки VBA:
' Insert Column after name and then rename it name+type
Rows(1).Find("name").Offset(0, 1).EntireColumn.Insert
Rows(1).Find("name").Offset(0, 1).FormulaR1C1 = "name+type"
Dim myRng As Range
Dim lastCell As Long
Dim myOtherRange As Range
Dim column2Range As Range
myOtherRange = Rows(1).Find("name")
column2Range = Rows(1).Find("name+type")
lastCell = Range(myOtherRange).End(xlDown).Row
Set myRng = Range("K2:K" & lastCell)
myOtherRange.FormulaR2C1 = "=LEFT(MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1),5)&RC[-1]"
myOtherRange.FormulaR2C1.Select
Selection.Copy
myRng.Select
ActiveSheet.Paste
Первый проект кода VBA:
' Insert Column after name and then rename it name+type
Rows(1).Find("name").Offset(0, 1).EntireColumn.Insert
Rows(1).Find("name").Offset(0, 1).FormulaR1C1 = "name+type"
'Add the contents to the name+type column
Range("K2").Select
ActiveCell.FormulaR1C1 = "=LEFT(MID(CELL(""filename"",RC[-1]),SEARCH(""["",CELL(""filename"",RC[-1]))+1,SEARCH(""]"",CELL(""filename"",RC[-1]))-SEARCH(""["",CELL(""filename"",RC[-1]))-1),5)&RC[-1]"
Range("K2").Select
Selection.Copy
Range("K2:K8294").Select
ActiveSheet.Paste
Ответ 1 · рейтинг 1 · Siddharth Rout
@Скотт или Сиддхарт Раут наверное =) - Джонни 11 часов назад
Я бы никогда не рекомендовал это :) В SO полно экспертов, которые могут вам помочь. Почему вы хотите ограничить помощь, которую вы можете получить? ;)
Это то, что вы пытаетесь?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, aCol As Long
Dim aCell As Range
Set ws = Sheets("Sheet1") '<~~ Change this to the relevant sheet name
With ws
Set aCell = .Rows(1).Find("Name")
'~~> Check if the column with "name" is found
If Not aCell Is Nothing Then
aCol = aCell.Column
.Columns(aCol + 1).EntireColumn.Insert
.Cells(1, aCol + 1).Value = "Name+Type"
.Activate
.Rows(1).Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
'~~> Get lastrow of Col which has "name"
lRow = .Range(Split(.Cells(, aCol).Address, "$")(1) & .Rows.Count).End(xlUp).Row
ThisWorkbook.Save
'~~> Add the formula to all the cells in 1 go.
.Range(Split(.Cells(, aCol + 1).Address, "$")(1) & "2:" & _
Split(.Cells(, aCol + 1).Address, "$")(1) & lRow).Formula = _
"=LEFT(MID(CELL(""filename"",RC[-1]),SEARCH(""["",CELL(""filename"",RC[-1]))+1," & _
"SEARCH(""]"",CELL(""filename"",RC[-1]))-SEARCH(""["",CELL(""filename"",RC[-1]))-1),5)&RC[-1]"
.Columns("A:AK").Columns.AutoFit
Else
MsgBox "Name Column Not Found"
End If
End With
End Sub
Ответ 2 · Jonny
После изменения кода, предоставленного Сиддхартом, это окончательный код, который у меня сработал. Функция сохранения также должна была удалить формат, а формула для поиска и добавления имени файла в ячейки не работала без этого редактирования. Мне также пришлось сменить лист на активный лист, потому что он постоянно менялся. Вот код:
Sub Naming()
Dim LR As Long, i As Long, lngCol As Long
lngCol = Rows(1).Find("NAME", lookat:=xlWhole).Column 'assumes there will always be a column with "NAME" in row 1
Application.ScreenUpdating = False
LR = Cells(Rows.Count, lngCol).End(xlUp).Row
For i = LR To 1 Step -1
If Len(Cells(i, lngCol).Value) < 4 Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
' Insert Column after NAME and then rename it NAME+TYPE
Dim ws As Worksheet
Dim lRow As Long, aCol As Long
Dim aCell As Range
Set ws = ActiveSheet 'Need to change to the Active sheet
With ws
Set aCell = .Rows(1).Find("NAME")
' Check if the column with "NAME" is found, it is assumed earlier
If Not aCell Is Nothing Then
aCol = aCell.Column
.Columns(aCol + 1).EntireColumn.Insert
.Cells(1, aCol + 1).Value = "NAME+TYPE"
.Activate
' Freeze the Top Row
Rows("1:1").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
' Get lastrow of Col which has "NAME"
lRow = .Range(Split(.Cells(, aCol).Address, "$")(1) & .Rows.Count).End(xlUp).Row
'Save the file and format the filetype
Dim wkb As Workbook
Set wkb = ActiveWorkbook 'change to your workbook reference
wkb.SaveAs Replace(wkb.Name, "#csv.gz", ""), 52 'change "csv.gz" to ".xlsm" if need be
' Add the formula to all the cells in 1 go.
.Range(Split(.Cells(, aCol + 1).Address, "$")(1) & "2:" & _
Split(.Cells(, aCol + 1).Address, "$")(1) & lRow).Formula = _
"=LEFT(MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1),5)&RC[-1]"
.Columns("A:AK").Columns.AutoFit
Else
MsgBox "NAME Column Not Found"
End If
End With
' Change the Range of the cursor
Range("A1").Select
Application.CutCopyMode = False
End Sub
