|
1、要有一些基本常识,字符型 与 数值型【DTQY("J","Q")】
2、原来考虑是简单的处理,返回的是数组,给你改为返回range对象
- Option Explicit
- Function DTQY(StartID As Variant, EndID As Variant, Optional RowOrColID As Variant = "", Optional shName As String = "") As Variant
- Dim rgCur As Range, strRowOrColID As String, strSelType As String
- Dim lngCurRow As Long, lngCurCol As Long
- Dim SelRow_Start As Long, SelRow_End As Long
- Dim SelCol_Start As Long, SelCol_End As Long
- Dim SelSh As Worksheet, arrResult As Variant
-
- '取得公式所在单元格的信息
- Set rgCur = Application.Caller
- lngCurRow = rgCur.Row
- lngCurCol = rgCur.Column
- '获取工作表
- If Trim(shName) = "" Then
- Set SelSh = rgCur.Worksheet
- Else
- Set SelSh = GetShByName(Trim(shName))
- End If
- If SelSh Is Nothing Then
- DTQY = "表名不存在"
- Exit Function
- End If
-
- '判断参数类型
- If IsNumeric(StartID) Then
- strSelType = "ROW"
- Else
- strSelType = "COL"
- End If
- '如果参数1与参数2类型不一致,退出
- If IsNumeric(StartID) <> IsNumeric(EndID) Then
- DTQY = "参数1、2类型不一致"
- Exit Function
- End If
- '如果参数1、2的类型与参数3相同,退出
- If RowOrColID <> "" And (IsNumeric(StartID) = IsNumeric(RowOrColID)) Then
- DTQY = "参数3类型不对"
- Exit Function
- End If
-
- '如果行号参数不对,退出
- If IsNumeric(StartID) And (Val(StartID) < 1 Or Val(StartID) > Rows.Count) Then
- DTQY = "参数1设置有误"
- Exit Function
- End If
- If IsNumeric(EndID) And (Val(EndID) < 1 Or Val(EndID) > Rows.Count) Then
- DTQY = "参数2设置有误"
- Exit Function
- End If
-
- '设置第三参数
- strRowOrColID = Trim(UCase(RowOrColID))
- '根据传入的参数,设置区域参数
- Select Case strSelType
- Case "ROW" '设置参数为行号
- SelRow_Start = Val(StartID) '起始行
- SelRow_End = Val(EndID) '结束行
- '根据第三参数获取列号
- If strRowOrColID <> "" Then
- lngCurCol = GetColIDByStr(strRowOrColID)
- End If
- '列号有误,退出
- If lngCurCol = 0 Then
- DTQY = "参数3设置有误"
- Exit Function
- End If
- '返回选择区域
- Set arrResult = SelSh.Range(SelSh.Cells(SelRow_Start, lngCurCol), SelSh.Cells(SelRow_End, lngCurCol))
- Case "COL" '设置参数为列号
- SelCol_Start = GetColIDByStr(CStr(StartID)) '起始列
- SelCol_End = GetColIDByStr(CStr(EndID)) '结束列
- If SelCol_Start * SelCol_End = 0 Then
- DTQY = "参数1、2设置有误"
- Exit Function
- End If
- '根据第三参数获取行号
- If strRowOrColID <> "" Then
- lngCurRow = Val(strRowOrColID)
- End If
- '行号有误,退出
- If lngCurRow < 1 Or lngCurRow > Rows.Count Then
- DTQY = "参数3设置有误"
- Exit Function
- End If
- '返回选择区域
- Set arrResult = SelSh.Range(SelSh.Cells(lngCurRow, SelCol_Start), SelSh.Cells(lngCurRow, SelCol_End))
- End Select
-
- '返回最终结果区域
- Set DTQY = arrResult
- End Function
- '根据列名,返回列标索引
- Function GetColIDByStr(strColName As String) As Long
- Dim strAddress As String, lngLen As Long
- Dim lngIndex As Long, strChar As String
- Dim lngColID As Long
-
- strAddress = Trim(UCase(strColName))
- lngLen = Len(strAddress)
-
- For lngIndex = 1 To lngLen
- strChar = Mid(strAddress, lngIndex, 1)
- If Asc(strChar) < 65 Or Asc(strChar) > 90 Then
- GetColIDByStr = 0
- Exit Function
- End If
- lngColID = lngColID + (((Asc(strChar) - 65) Mod 26) + 1) * (26 ^ (lngLen - lngIndex))
- Next
-
- If lngColID > Columns.Count Then
- GetColIDByStr = 0
- Exit Function
- End If
-
- GetColIDByStr = lngColID
- End Function
- '根据表名返回工作表
- Function GetShByName(strShName As String) As Worksheet
- Dim sh As Worksheet
- For Each sh In Sheets
- If sh.Name = strShName Then
- Set GetShByName = sh
- Exit Function
- End If
- Next
- Set GetShByName = Nothing
- End Function
复制代码 |
评分
-
1
查看全部评分
-
|