0

这是来自这篇文章的另一个问题：如何使用 excel 文件的文件名来更改一列单元格？

我注意到在上一篇文章的代码中它引用了特定的单元格（J2，K2）。但是，在使用代码时，当列更改时出现错误。所以现在我正在寻找一种方法来修改下面的代码，以使用标题列的名称来填充第二列，而不是引用特定的单元格。我认为唯一真正需要调整的行是 myRng 行，但我会提供我正在尝试的所有代码以供参考。

如果您没有阅读其他帖子，我将描述该问题。我正在尝试根据“名称”列和文件名填写第二列（名称+类型）。当我在代码中引用 K 或 J 行时，一切正常，但是当我加载不同的文件并且列位置发生变化时，一切都变得混乱了。

我需要将第二列（名称+类型）填充为与第一列（名称）完全相同的数字或行，这就是我使用范围（“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
4

2 回答 2

1

@Scott 或 Siddharth Rout 可能 =) – Jonny 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
于 2012-06-28T08:27:12.423 回答
0

在修改了 Siddharth 提供的代码之后，这是对我有用的最终代码。如果没有此编辑，还需要删除格式和公式来搜索并将文件名添加到单元格中的保存功能不起作用。我还必须将工作表更改为 activeSheet，因为它一直在变化。这是代码：

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
于 2012-06-28T14:09:13.427 回答