[已解决]请老师指导一下， 运行错误’9‘，下标越界是啥意思，谢谢

hasyh2008

gaiety1974 发表于 2022-6-8 15:17
老师谢谢指导，可以了。
另外可以的话帮忙再问下，如果我的数据这个文件在目录下面有几个，文件名后缀不 ...

上传附件

gaiety1974

hasyh2008 发表于 2022-6-8 15:30
上传附件

Test.zip (37.88 KB, 下载次数: 3)

2022-6-8 15:46 上传

点击文件名下载附件

谢谢老师指导，谢谢

hasyh2008

Sub 导入数据()
  Dim MyFile As Object
  Dim Arr, ArrName()
  Dim Rc%, K%
  Dim FileName$, Str$
  Dim Wb As Workbook
  Set MyFile = CreateObject("scripting.filesystemobject")
  FileName = Dir(ThisWorkbook.Path & "\*.xlsx", 16)
  Do While FileName <> ""
      K = K + 1
      ReDim Preserve ArrName(1 To K)
      ArrName(K) = ThisWorkbook.Path & "\" & FileName
      FileName = Dir
  Loop
  With ThisWorkbook.Sheets("Sheet1")
      .Range("A1").CurrentRegion = ""
      .Range("A1:C1") = Array("类别", "值", "姓名")
  End With
  For K = 1 To UBound(ArrName)
    Str = MyFile.getbasename(ArrName(K))
    Set Wb = Workbooks.Open(ArrName(K))
    With Wb
      .Sheets(1).Range("C1") = "姓名"
      Rc = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
      .Sheets(1).Range("C2:C" & Rc) = VBA.Right(Str, VBA.Len(Str) - 2)
      Arr = .Sheets(1).Range("A1").CurrentRegion.Offset(1)
      .Close False
    End With
    With ThisWorkbook.Sheets("Sheet1")
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(Arr), 3) = Arr
    End With
  Next K
  Set MyFile = Nothing
  Set Wb = Nothing
End Sub

scnc001

学习了。。

gaiety1974

hasyh2008 发表于 2022-6-8 16:50
Sub 导入数据()
  Dim MyFile As Object
  Dim Arr, ArrName()

谢谢高手老师，学习学习，谢谢啦