Откройте тихий файл Excel из списка, чтобы изменить значение на определенную ячейку

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

Я думаю, что безмолвный означает не видеть открытые файлы

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

Answer 2

Может быть, это то, что вы ищете, иначе я не смог понять

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