VBA - Excel 为每个活动行附加文件名

VBA - Excel Append Every Active Row With File Name

我是 VBA 的新手,请多多包涵。我想在每个活动行的最后一个单元格中附加文件名。因此,例如 Row/Column A1、B1、C1 和 D1 已填充 我想将文件名添加到单元格 E1。文件名只能附加到活动行。我玩过不同的迭代,但运气不佳。以下是我到目前为止所拥有的,逻辑显然是不正确的。任何帮助,将不胜感激。谢谢!

子插入文件名()

Dim Count1 As Long
Count1 = 1
Dim ColumnE As String
ColumnE = "E1"


While Cells(Count1, 1) <> ""
Range(ColumnE).Select
ActiveCell.FormulaR1C1 = _
    "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1)"
ColumnE = Range(ActiveCell, ActiveCell.Offset(1, 0)).Select
Count1 = Count1 + 1
Wend

结束子

此代码从第一行迭代到最后一行,并通过从 sheet 的边缘模仿 CTRL+LEFT 找到每一行的最后一列。

不假设所有行的列数都相同

Dim LastRow As Long
Dim LastColumn As Long
Sub InsertFileName()
  Application.ScreenUpdating = False
  Dim i as Long
  LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
  For i=1 To LastRow
    LastColumn = ActiveSheet.Cells(i, ActiveSheet.Columns.Count).End(xlToLeft).Column
    ActiveSheet.Cells(i,LastColumn+1)="=CELL(""filename"")"
  Next i
  Application.ScreenUpdating = True
End Sub

一个简单的解决方案。添加要附加的 fileName 的值和数据的起始行 stRow

Sub InsertFilename()
Dim stRow As Long, endRow As Long, endCol As Long, c As Long
Dim fileName As String

fileName = "C:\Data\somefile.xlsx"
stRow = 1
    With ActiveSheet
        endRow = .Cells(Rows.Count, 1).End(xlUp).Row
            For c = stRow To endRow
                endCol = .Cells(c, Columns.Count).End(xlToLeft).Column
                    If endCol > 1 Then
                        .Cells(c, endCol + 1) = fileName
                    End If
            Next
    End With
End Sub

此解决方案使用 Counta 测试 activity 并使用每个活动行的最后一列来使用活动工作簿的全名。

Dim lngLastRow As Long
Dim lngLastCol As Long
Dim lngCounter As Long

lngLastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lngLastCol = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

For lngCounter = 1 To lngLastRow
    If WorksheetFunction.CountA(Range(Cells(lngCounter, 1), Cells(lngCounter, lngLastCol))) > 0 Then
        Cells(lngCounter, lngLastCol + 1).End(xlToLeft).Offset(0, 1).Value = ActiveWorkbook.FullName
    End If
Next lngCounter