| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 643 人关注过本帖
标题:请教关于VB读取excel列的最大值与最小值!
只看楼主 加入收藏
事业男儿
Rank: 2
等 级:论坛游民
帖 子:271
专家分:14
注 册:2007-4-25
结帖率:81.97%
  已结贴   问题点数:20  回复次数:4   
请教关于VB读取excel列的最大值与最小值!
在工作中总要看看数据最大值与最小值,然而每次用公式感觉很麻烦,而且行数又多,希望用VB来做个软件,随时读取比较方便,以下代码在网上找到的读取最大值,但是我想同时读取最大值与最小值所以在上面加了很多代码,功能是实现了,但是觉得声明栏里的代码,可以很精简的,就是不知道怎么写,还有一个就是我想在界面多画一个Text.Text,用于输入不同的列,A.B.C......请各位老师指点一下
Function GetMinValueFromColumn(ByVal Path As String, ByVal SheetName As String, ByVal RangeName As String) As Variant
 Dim xlWb As Object

 On Error Resume Next

 Set xlWb = GetObject(Path)

 If Err.Number = 0 Then
 GetMinValueFromColumn = xlWb.Application.WorksheetFunction.Min(xlWb.Sheets(SheetName).Range(RangeName))
 Else
 GetMinValueFromColumn = "Error"
 End If

 If Not (xlWb Is Nothing) Then Set xlWb = Nothing
End Function
'.................................................................................................................................
Function GetMaxValueFromColumn(ByVal Path As String, ByVal SheetName As String, ByVal RangeName As String) As Variant

Dim xlWb As Object

 On Error Resume Next

Set xlWb = GetObject(Path)

If Err.Number = 0 Then
GetMaxValueFromColumn = xlWb.Application.WorksheetFunction.Max(xlWb.Sheets(SheetName).Range(RangeName))
Else
GetMaxValueFromColumn = "Error"
 End If

 If Not (xlWb Is Nothing) Then Set xlWb = Nothing
End Function
Private Sub Command1_Click()
 Text1.Text = GetMinValueFromColumn(App.Path & "\Test.xlsx", "Sheet1", "A1:A8")
 Text2.Text = GetMaxValueFromColumn(App.Path & "\Test.xlsx", "Sheet1", "A1:A8")
End Sub


2018-04-04 14:24
wds1
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:23
帖 子:249
专家分:1371
注 册:2016-3-10
  得分:0 
text1.text定义列。例如内容为A,就是读A列

Private Sub Command1_Click()
 Dim max1, min1
 Call Load_execl("d:\1.xls", Text1.Text, max1, min1)
 MsgBox max1
 MsgBox min1
End Sub

Public Sub Load_execl(execl_name, ByVal column1 As String, max1, min1)
  Dim xlapp As Excel.Application
  Dim xlBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
  Dim rows, temp
  Set xlapp = CreateObject("Excel.Application")
  xlapp.Visible = False
  Set xlBook = xlapp.Workbooks.Open(execl_name)
  Set xlSheet = xlBook.Worksheets(1)
  rows = xlSheet.UsedRange.rows.Count '【行数】
  temp = column1 & "1:" & column1 & Trim(Str(rows))
  max1 = xlSheet.Application.Max(Range(temp))
  min1 = xlSheet.Application.Min(Range(temp))
  xlBook.Close (True)
  xlapp.Quit
  Set xlapp = Nothing
End Sub
2018-04-04 15:41
事业男儿
Rank: 2
等 级:论坛游民
帖 子:271
专家分:14
注 册:2007-4-25
  得分:0 
请问版主,这个代码在运行过程中修改excel的裂和行怎么不管用,甚至显示最大值与最小的控件都会消失,这是怎么回事呢!
Private Sub Command1_Click()
  Dim max1, min1
  Call Load_execl("D:\1.xlsx", Text1.Text, max1, min1)
  Label1.Caption = max1
  Label2.Caption = min1
 End Sub

 Public Sub Load_execl(execl_name, ByVal column1 As String, max1, min1)
   Dim xlapp As Excel.Application
   Dim xlBook As Excel.Workbook
   Dim xlSheet As Excel.Worksheet
   Dim rows, temp
   Set xlapp = CreateObject("Excel.Application")
   xlapp.Visible = False
   Set xlBook = xlapp.Workbooks.Open(execl_name)
   Set xlSheet = xlBook.Worksheets(1)
   rows = xlSheet.UsedRange.rows.Count '【行数】
  temp = column1 & Text2.Text & column1 & Trim(Str(rows))
 On Error Resume Next
   max1 = xlSheet.Application.Max(Range(temp))
   min1 = xlSheet.Application.Min(Range(temp))
   xlBook.Close (True)
   xlapp.Quit
   Set xlapp = Nothing
 End Sub
附件: 您没有浏览附件的权限,请 登录注册
2018-04-05 02:42
wds1
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:23
帖 子:249
专家分:1371
注 册:2016-3-10
  得分:20 
不是控件消失,是你计算出的值为空。
另外就是最大,最小值语句修改了一下,避免二次运行报错
Private Sub Command1_Click()
  Dim max1, min1
  Call Load_execl("D:\1.xls", UCase(Text1.Text), max1, min1)
  Label1.Caption = IIf(max1 = "", "没有值", max1)
  Label2.Caption = IIf(min1 = "", "没有值", min1)
End Sub

Private Sub Load_execl(execl_name, ByVal column1 As String, max1, min1)
   Dim xlapp As Excel.Application
   Dim xlBook As Excel.Workbook
   Dim xlSheet As Excel.Worksheet
   Dim rows, temp
   Set xlapp = CreateObject("Excel.Application")
   xlapp.Visible = False
   Set xlBook = xlapp.Workbooks.Open(execl_name)
   Set xlSheet = xlBook.Worksheets(1)
   rows = xlSheet.UsedRange.rows.Count '【行数】
   temp = column1 & Text2.Text & column1 & Trim(Str(rows))
 On Error Resume Next'此语句建议不用,否则程序有的错误会发现不了
'以下2条语句调整了,原来语句单次运行不会有问题,二次运行可能会出现不能计算问题,此问题属于execl限定问题
   max1 = xlSheet.Application.Max(xlSheet.Range(temp))
   min1 = xlSheet.Application.Min(xlSheet.Range(temp))
   xlBook.Close (True)
   xlapp.Quit
   Set xlapp = Nothing
 End Sub
2018-04-05 08:46
事业男儿
Rank: 2
等 级:论坛游民
帖 子:271
专家分:14
注 册:2007-4-25
  得分:0 
问题终于搞定,谢谢wds1版主,耐心的结束!
2018-04-05 13:29







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.027421 second(s), 9 queries.
Copyright©2004-2018, BCCN.NET, All Rights Reserved