修改代码

xing_chen

老师，有簿，希望点击文件夹，导入文件夹下工作簿到本工作簿，但现有代码可以导入，但有2个问题需请老师赐教，1是全选文件夹下工作簿时，顺序簿对；2是希望表头只留1行；3是希望将原表头的月移到列。敬请老师赐教。谢谢！

xing_chen

发现好多导入的文件一般都有，原最后位置的文件导入后，都会放首位。这是什么原因？

lskvslgt

GPT回复可以对该段代码进行如下优化和修改。

顺序问题：修改代码如下，添加一个遍历数组元素前的排序：
x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _
Title:="Excel选择", MultiSelect:=True)
If Not IsArray(x) Then Exit Sub
x = SortArr(x)
'定义一个子函数SortArr，用于将文件名按照从小到大的顺序排序
Function SortArr(ByRef arr() As Variant) As Variant()
   Dim i As Long, j As Long, temp As Variant
   For i = LBound(arr) To UBound(arr) - 1
       For j = i + 1 To UBound(arr)
           If arr(i) > arr(j) Then
               temp = arr(i)
               arr(i) = arr(j)
               arr(j) = temp
           End If
        Next j
    Next i
    SortArr = arr
End Function
表头只留1行：将第一行及以下的内容清空，并且只保留第一行即可。修改代码如下：
Set ts = t.Sheets(3)
ts.Cells.ClearContents
ts.Range("A1").Value = "日期"
l = ts.Range("A1").Column
希望将原表头的月移到列：在打开工作簿后，可以先把原来的表头放置到新的位置，然后删除第一行的代码即可。具体代码修改如下：
Set w = Workbooks.Open(x1)
Set wsh = w.Sheets(1)
h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row
wsh.Range("A1", wsh.Cells(1, l)).Copy ts.Cells(1, 2)
wsh.UsedRange.Offset(1, 0).Copy ts.Cells(h + 1, 1)
w.Close[/code]

bqwd36

我猜是没用 after：=thisworkbook.sheets(thisworkbook.sheets.count)

ykcbf1100

改用数组，尽量保留你自己的代码。

不过，如果是我，不会象你这样写。

yylucke

建议：
循环里这样写：
        With Workbooks.Open(x1, ReadOnly:=True)
            With .Sheets(1)
                MaxR = .Cells(Rows.Count, 2).End(3).Row
                If MaxR > 3 Then
                    MaxR1 = ts.Cells(Rows.Count, 2).End(3).Row + 1
                    .Range(.Cells(4, 1), .Cells(MaxR, "E")).Copy ts.Cells(MaxR1, 1)
                    ts.Cells(MaxR1, "F").Resize(MaxR - 3, 1).Formula = .Range("B2")
                End If
            End With
            .Close
        End With

xing_chen

ykcbf1100 发表于 2023-3-30 15:06
改用数组，尽量保留你自己的代码。

不过，如果是我，不会象你这样写。

谢谢老师！我也是东拼西凑的，哈哈！另，SORT的升序功能没有实现。

xing_chen

ykcbf1100 发表于 2023-3-30 15:06
改用数组，尽量保留你自己的代码。

不过，如果是我，不会象你这样写。

老师，刚发了好久也未显示。现简言。代码未升序。

ykcbf1100

xing_chen 发表于 2023-3-30 16:24
老师，刚发了好久也未显示。现简言。代码未升序。

按月份排序了，只是序号未写，要写也简单。

xing_chen

ykcbf1100 发表于 2023-3-30 16:28
按月份排序了。

老师，代码中有.Sort .[f2], 1，但未起作用