Question

我对vba有点陌生，我很难拿出代码来做我要解释的事情，我能得到的任何帮助都将受到高度赞赏。

Sub FileNametoExcel()

Dim fnam As Variant
' fnam is an array of files returned from GetOpenFileName
' note that fnam is of type boolean if no array is returned.
' That is, if the user clicks on cancel in the file open dialog box, fnam is set to FALSE

Dim b As Integer 'counter for filname array
Dim b1 As Integer 'counter for finding \ in filename
Dim c As Integer 'extention marker

' format header
Range("A1").Select
ActiveCell.FormulaR1C1 = "Path and Filenames that had been selected to Rename"
Range("A1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
End With

' first open a blank sheet and go to top left ActiveWorkbook.Worksheets.Add

fnam = Application.GetOpenFilename("all files (*.*), *.*", 1, _
"Select Files to Fill Range", "Get Data", True)

If TypeName(fnam) = "Boolean" And Not (IsArray(fnam)) Then Exit Sub

'if user hits cancel, then end

For b = 1 To UBound(fnam)
' print out the filename (with path) into first column of new sheet
ActiveSheet.Cells(b + 1, 1) = fnam(b)
Next


End Sub

在A:A上有文件列表之后，我想做的就是打开这些工作簿并将b3的值替换为=MID(CELL("filename"),SEARCH("[",CELL("filename"))+1,SEARCH(".xlsx",CELL("filename"))-SEARCH("[",CELL("filename"))-1) 然后另存为而不更改路径。

Answer 1

可能是您正在寻找的东西，否则我将无法理解

Dim Wb As Workbook, rng As Range
Application.ScreenUpdating = False  ' Since you mentioned Silent
    For b = 1 To UBound(fnam)
    ThisWorkbook.ActiveSheet.Cells(b + 1, 1) = fnam(b)
    Set Wb = Workbooks.Open(fnam(b))
    Wb.Sheets(1).Range("B3").Formula = "=MID(CELL(" & Chr(34) & "filename" & Chr(34) & "),SEARCH(" & Chr(34) & "[" & Chr(34) & ",CELL(" & Chr(34) & "filename" & Chr(34) & "))+1,SEARCH(" & Chr(34) & ".xlsx" & Chr(34) & ",CELL(" & Chr(34) & "filename" & Chr(34) & "))-SEARCH(" & Chr(34) & "[" & Chr(34) & ",CELL(" & Chr(34) & "filename" & Chr(34) & "))-1)"
    Wb.Close True
    Next
Application.ScreenUpdating = True

Answer 2

我认为沉默意味着没有看到打开的文件

Sub FiletoExcel()
fnam = Application.GetOpenFilename("all files (*.xls*), *.xls*", 1, _
"Select Files to Fill Range", "Get Data", True)
If TypeName(fnam) = "Boolean" And Not (IsArray(fnam)) Then Exit Sub
Set exlApp = CreateObject("Excel.Application")
For b = 1 To UBound(fnam)
    Set Wb = exlApp.Workbooks.Open(fnam(b))
    Wb.Sheets(1).Range("B3").Formula = "=MID(CELL(" & Chr(34) & "filename" & Chr(34) & "),SEARCH(" & Chr(34) & "[" & Chr(34) & ",CELL(" & Chr(34) & "filename" & Chr(34) & "))+1,SEARCH(" & Chr(34) & ".xlsx" & Chr(34) & ",CELL(" & Chr(34) & "filename" & Chr(34) & "))-SEARCH(" & Chr(34) & "[" & Chr(34) & ",CELL(" & Chr(34) & "filename" & Chr(34) & "))-1)"

    Wb.Close True
Next
exlApp.Quit
Set exlApp = Nothing
End Sub

从列表中打开无提示Excel文件以将值更改为特定的单元格

2 个答案: