Question

我的目录中有10个txt文件。我想在Excel中对其进行一些更改。我需要将所有内容打开到不同的工作簿中，并循环浏览每个工作簿并进行一些更改。或者，最好是全部打开到一个文件，不同的工作表中。

这是我的原始宏（不起作用），我可能会向其中添加更多内容，但是主要思想是遍历所有工作簿（如果是工作表，我想我知道如何把它拉下来，我只需要帮助将txt文件移到工作表中即可）

任何帮助将不胜感激！

Sub ExifToolEdit()

Dim wb As Workbook


For Each wb In Application.Workbooks
  If wb.Name <> "PERSONAL.xlsb" Then

    wb.Activate
    If Worksheets(1).Name <> "Default" Then
    Worksheets(1).Name = "Default"
    End If

wb.Worksheets.Add After:=wb.Worksheets(1)
wb.Worksheets(2).Name = "Edited"



Dim LastRow As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Columns("B").NumberFormat = "@"



Dim EndOfColumnA As Integer
For i = 1 To LastRow




    Cells(i, 2) = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)

    Cells(i, 1) = Left(Cells(i, 1), EndOfColumnA - 1)

End If

Next i

Columns(1).Select
ActiveCell.EntireColumn.Columns.AutoFit

Columns(2).Select
ActiveCell.EntireColumn.Columns.AutoFit

Cells(1, 3) = Cells(4, 2) & "/" & Cells(3, 2)



    Dim Pshp As shape
    Dim xRg As Range
    Dim xCol As Long
    Dim WidthFlag As Boolean
    Dim myRow, myColumn, LastRowFromCurrent As Integer

    Cells(1, 3).Select

    On Error Resume Next
    Application.ScreenUpdating = False
    Set rng = ActiveCell
    For Each cell In rng
        filenam = cell
        ActiveSheet.Pictures.Insert(filenam).Select
        Set Pshp = Selection.ShapeRange.Item(1)
        If Pshp Is Nothing Then GoTo lab
        xCol = cell.Column + 1
        Set xRg = Cells(cell.Row, xCol)

        With Pshp

            .LockAspectRatio = msoTrue
            .height = 250

        End With
lab:
    Next
    Application.ScreenUpdating = False


  Application.ScreenUpdating = True

  Cells(1, 3).ClearContents

End If
Next wb

End Sub

Excel Circle打开工作簿并修改每个工作表

0 个答案: