Question

我想用宏获得范围的最大值。我使用下面你可以看到的代码，但是我总是遇到错误。我尝试了一切，但我无法解决。如何获得不同excel的A列的最大值？

Sub Button1_Click()
Sheet1.Range("a3:d65536").ClearContents
Dim con As Object, evn As Object, yol As String
yol = "\datalar"
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder(ThisWorkbook.Path & yol)
For Each xls In klasor.Files
If UCase(VBA.Right(xls.Name, 3)) = "XLS" Then
Set con = CreateObject("adodb.connection")
con.Open " provider=microsoft.jet.oledb.4.0;data source=" & xls.Path & ";extended properties=""excel 8.0;hdr=no"""
Range("a65536").End(3)(2, 1).Value = con.Execute("select * from [Max(Data1$a3:a10)]").Fields(0).Value
End If
Next xls
con.Close: yol = vbNullString
Set rs = Nothing: Set con = Nothing
Set evn = Nothing: Set klasor = Nothing: Set xls = Nothing
End Sub

有谁知道我该怎么做？

谢谢，

Answer 1

文件夹对象无疑可以最全面地访问文件信息，但较旧的Dir函数更易于使用，并允许指定文件名模板，因此我使用了它。

我不是ADODB的专家，并且使用了打开每本书籍的简单技术来访问其工作表。

我无法从您的代码中知道您存储所收集信息的位置，因此我创建了一个工作表＆＃34; Ranges＆＃34;把它存放在那里。

我希望我提供了足够的评论，让您了解我的代码。询问是否有任何不清楚的地方。

Option Explicit
Sub Button1_Click()

  Dim ColTgtMax As Long
  Dim Filename As String
  Dim InxWsht As Long
  Dim Path As String
  Dim Rng As Range
  Dim RowTgtMax As Long
  Dim RowSaveCrnt As Long
  Dim WbkTgt As Workbook
  Dim WshtTgtName As String
  Dim WshtSave As Worksheet

  Application.ScreenUpdating = False

  Set WshtSave = ThisWorkbook.Worksheets("Ranges")
  With WshtSave
    .Cells.EntireRow.Delete
    .Cells(1, 1).Value = "Workbook"
    .Cells(1, 2).Value = "WorkSheet"
    .Cells(1, 3).Value = "Max row"
    .Cells(1, 4).Value = "Max col"
    .Range(.Cells(1, 1), .Cells(1, 4)).Font.Bold = True
    RowSaveCrnt = 2
  End With

  ' ### You need to remove quote
  Path = ThisWorkbook.Path  ' & "\datalar"

  Filename = Dir$(Path & "\*.xls")

  ' Loop for every XLS workbook in folder
  Do While Filename <> ""

    If Filename <> ThisWorkbook.Name Then

      ' Open workbook
      Set WbkTgt = Workbooks.Open(Path & "\" & Filename)

      ' Access each worksheet and identify maximum row and column
      For InxWsht = 1 To WbkTgt.Worksheets.Count

        With WbkTgt.Worksheets(InxWsht)
          WshtTgtName = .Name
          Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
          If Rng Is Nothing Then
            ' This worksheet unused
            RowTgtMax = 0
            ColTgtMax = 0
          Else
            RowTgtMax = Rng.Row
            ColTgtMax = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
          End If
        End With

        ' Record value for this worksheet
        With WshtSave
          .Cells(RowSaveCrnt, 1).Value = Filename
          .Cells(RowSaveCrnt, 2).Value = WshtTgtName
          If RowTgtMax = 0 Then
            .Cells(RowSaveCrnt, 5).Value = "Worksheet not used"
          Else
            .Cells(RowSaveCrnt, 3).Value = RowTgtMax
            .Cells(RowSaveCrnt, 4).Value = ColTgtMax
          End If
          RowSaveCrnt = RowSaveCrnt + 1
        End With

      Next

    End If

    WbkTgt.Close SaveChanges:=False

    Filename = Dir$      ' Get next file name

  Loop

  With WshtSave
    .Columns.AutoFit
  End With

End Sub

从另一个excel文件中获取最大值

1 个答案: