Question

我有一个宏，它填充图表并向工作簿添加两个工作表。如何添加从特定文件夹中的excel文件中提取数据的工作表，并将excel文件添加到其他两个工作表之前的工作表中？

Private Sub Workbook_Open()

    Dim files(1 To 20) As String
    Dim numOfFiles As Integer
    Dim chartName As String
    Dim FilePath As String
    Dim strPath As String
    Dim strFile As String
    Dim strFile1 As String
    Dim strChart As String
    Dim i As Integer
    Dim j As Integer


    strPath = "C:\PortableRvR\report\"
    strFile = Dir(strPath & "*.csv")
    i = 1
    Do While strFile <> ""
        With ActiveWorkbook.Worksheets.Add
            With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
                Destination:=.Range("A1"))
                .Parent.Name = Replace(strFile, ".csv", "")
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
                files(i) = .Parent.Name
                i = i + 1
            End With
        End With
        strFile = Dir
    Loop

    chartName = "Chart 8"
    For j = 1 To numOfFiles
        strFile = files(j)
        Sheets(strFile).Select
        Plot_y = Range("E1", Selection.End(xlDown)).Rows.Count
        Plot_x = Range("D1", Selection.End(xlDown)).Rows.Count

        Sheets("Uplink VS attenuation").Select
        If j = 1 Then ActiveSheet.ChartObjects(chartName).Activate

        With ActiveChart

            .HasTitle = True
            .ChartTitle.Characters.Text = "TxPower"
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Attenuation(dB)"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "TxPower(dBm)"
            .Axes(xlCategory, xlPrimary).MinimumScale = 30 ' Constant value

        End With

        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.SeriesCollection(j).Name = strFile
        ActiveChart.SeriesCollection(j).XValues = Sheets(strFile).Range("D1:D" & Plot_x)
        ActiveChart.SeriesCollection(j).Values = Sheets(strFile).Range("E1:E" & Plot_y)
        ActiveChart.SeriesCollection(j).MarkerStyle = -4142
        ActiveChart.SeriesCollection(j).Smooth = False
    Next j

    ActiveSheet.ChartObjects(chartName).Activate
    ActiveChart.Axes(xlValue).DisplayUnit = xlMillions
    ActiveChart.Axes(xlValue).HasDisplayUnitLabel = False
End Sub

Answer 1

要将Sample.txt中的Sheet1添加到具有Sheets("Uplink VS attenuation")的Book2.xlsx，您可以使用此示例代码

请根据您的需要进行修改。

Sub Sample()
    Dim wb As Workbook, wbTemp As Workbook
    Dim ws As Worksheet, wsTemp As Worksheet

    '~~> This is the workbook which has the "Uplink VS attenuation" sheet
    Set wb = ThisWorkbook
    Set ws = Sheets("Uplink VS attenuation")

    '~~> Open the relevant text file. Change as applicable
    Workbooks.OpenText Filename:="C:\Temp\Sample.txt", Origin:=437, _
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
    Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True

    Set wbTemp = ActiveWorkbook
    Set wsTemp = wbTemp.Sheets(1)

    '~~> Copy the relevant sheet before "Uplink VS attenuation"
    wsTemp.Copy Before:=ws

    '~~> Close text file without saving
    wbTemp.Close savechanges:=False

    '~~> Clean Up
    Set wb = Nothing: Set wbTemp = Nothing
    Set ws = Nothing: Set wsTemp = Nothing
End Sub

注意：我没有做任何错误处理。我相信你可以照顾它：）

HTH

西特

在excel中现有工作表旁边的工作表中添加XLS文件

1 个答案: