设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 取XY坐标大小值
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2390|回复: 5

[已解决]取XY坐标大小值

[复制链接]
发表于 2013-6-21 22:36 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
A列数据源%上有带T数据全部删除，用C2&D2合并数据代替。
在%下，保留T1，找出坐标X最大，最小，Y最大，最小值，和M30，其他删除。有含有G85双坐标不计算，如A23，A24，不是坐标不计算如A26''M97,*", 计算坐标大小时，一定按6位数计算，要不结果不对，如A11，后面不加0，就不是Y最大，最后结果如B列，谢谢！！！

最佳答案
月排行榜 / 总排行榜
hwc2ycy
2013-6-22 21:11
  1. Sub arr2()
  2.     Dim arr(), arrResult(1 To 9, 1 To 1)
  3.     Dim lLastRow&
  4.     Dim i As Long
  5.     Dim strTemp As String
  6.     Dim arrTemp, xTemp As String, yTemp As String
  7.     Dim lMin As Long, lMax As Long
  8.     Dim objDicX As Object, objDicY As Object

  10.     Set objDicX = CreateObject("scripting.dictionary")
  11.     Set objDicY = CreateObject("scripting.dictionary")

  13.     lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  14.     arr = Range("a1:a" & lLastRow).Value
  15.     arrResult(1, 1) = arr(1, 1)
  16.     arrResult(9, 1) = "M30"
  17.     arrResult(2, 1) = [c2].Value & [d2].Value
  18.     arrResult(3, 1) = "%"
  19.     arrResult(4, 1) = "T1"
  20.     Do
  21.         i = i + 1
  22.     Loop Until arr(i, 1) = "%"
  23.     Do While arr(i, 1) <> "M30" And i <= UBound(arr)
  24.         If Not arr(i, 1) Like "*G85*" Then
  25.             strTemp = arr(i, 1)
  26.             If strTemp Like "X*Y*" Then
  27.                 xTemp = Mid(strTemp, 2, InStr(strTemp, "Y") - 1)

  29.                 If Left(xTemp, 1) = "-" Then
  30.                     xTemp = Left(xTemp & "000000", 7)
  31.                 Else
  32.                     xTemp = Left(xTemp & "000000", 6)
  33.                 End If

  35.                 yTemp = Mid(strTemp, InStr(strTemp, "Y") + 1)
  36.                 If Left(yTemp, 1) = "-" Then
  37.                     yTemp = Left(yTemp & "000000", 7)
  38.                 Else
  39.                     yTemp = Left(yTemp & "000000", 6)
  40.                 End If
  41.                 objDicX(xTemp) = strTemp
  42.                 objDicY(yTemp) = strTemp
  43.             End If
  44.         End If
  45.         i = i + 1
  46.     Loop
  47.    
  48.     'X值最大小值
  49.     If objDicX.Count Then
  50.         arrTemp = objDicX.keys
  51.         For i = LBound(arrTemp) To UBound(arrTemp)
  52.             arrTemp(i) = Val(arrTemp(i))
  53.         Next

  55.         lMin = WorksheetFunction.Match(WorksheetFunction.Min(arrTemp), arrTemp, False)
  56.         lMax = WorksheetFunction.Match(WorksheetFunction.Max(arrTemp), arrTemp, False)
  57.         arrTemp = objDicX.keys
  58.         arrResult(5, 1) = objDicX(arrTemp(lMin - 1))
  59.         arrResult(6, 1) = objDicX(arrTemp(lMax - 1))
  60.     End If
  61.    
  62.     'Y值最大小值
  63.     If objDicY.Count Then
  64.         arrTemp = objDicY.keys
  65.         For i = LBound(arrTemp) To UBound(arrTemp)
  66.             arrTemp(i) = Val(arrTemp(i))
  67.         Next
  68.         
  69.         lMin = WorksheetFunction.Match(WorksheetFunction.Min(arrTemp), arrTemp, False)
  70.         lMax = WorksheetFunction.Match(WorksheetFunction.Max(arrTemp), arrTemp, False)
  71.         arrTemp = objDicY.keys
  72.         arrResult(7, 1) = objDicY(arrTemp(lMin - 1))
  73.         arrResult(8, 1) = objDicY(arrTemp(lMax - 1))

  75.     End If
  76.     Range("e1").Resize(UBound(arrResult), 1).Value = arrResult
  77. End Sub
复制代码

取XY坐标大小值.rar

9.57 KB, 下载次数: 8
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2013-6-22 20:49 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
为什么是后补0呢。
回复

使用道具 举报

hwc2ycy
发表于 2013-6-22 20:54 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
X,Y值都是数字不足6位在后面补0么？
回复

使用道具 举报

hwc2ycy
发表于 2013-6-22 21:11 | 显示全部楼层    本楼为最佳答案   
  1. Sub arr2()
  2.     Dim arr(), arrResult(1 To 9, 1 To 1)
  3.     Dim lLastRow&
  4.     Dim i As Long
  5.     Dim strTemp As String
  6.     Dim arrTemp, xTemp As String, yTemp As String
  7.     Dim lMin As Long, lMax As Long
  8.     Dim objDicX As Object, objDicY As Object

  10.     Set objDicX = CreateObject("scripting.dictionary")
  11.     Set objDicY = CreateObject("scripting.dictionary")

  13.     lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  14.     arr = Range("a1:a" & lLastRow).Value
  15.     arrResult(1, 1) = arr(1, 1)
  16.     arrResult(9, 1) = "M30"
  17.     arrResult(2, 1) = [c2].Value & [d2].Value
  18.     arrResult(3, 1) = "%"
  19.     arrResult(4, 1) = "T1"
  20.     Do
  21.         i = i + 1
  22.     Loop Until arr(i, 1) = "%"
  23.     Do While arr(i, 1) <> "M30" And i <= UBound(arr)
  24.         If Not arr(i, 1) Like "*G85*" Then
  25.             strTemp = arr(i, 1)
  26.             If strTemp Like "X*Y*" Then
  27.                 xTemp = Mid(strTemp, 2, InStr(strTemp, "Y") - 1)

  29.                 If Left(xTemp, 1) = "-" Then
  30.                     xTemp = Left(xTemp & "000000", 7)
  31.                 Else
  32.                     xTemp = Left(xTemp & "000000", 6)
  33.                 End If

  35.                 yTemp = Mid(strTemp, InStr(strTemp, "Y") + 1)
  36.                 If Left(yTemp, 1) = "-" Then
  37.                     yTemp = Left(yTemp & "000000", 7)
  38.                 Else
  39.                     yTemp = Left(yTemp & "000000", 6)
  40.                 End If
  41.                 objDicX(xTemp) = strTemp
  42.                 objDicY(yTemp) = strTemp
  43.             End If
  44.         End If
  45.         i = i + 1
  46.     Loop
  47.    
  48.     'X值最大小值
  49.     If objDicX.Count Then
  50.         arrTemp = objDicX.keys
  51.         For i = LBound(arrTemp) To UBound(arrTemp)
  52.             arrTemp(i) = Val(arrTemp(i))
  53.         Next

  55.         lMin = WorksheetFunction.Match(WorksheetFunction.Min(arrTemp), arrTemp, False)
  56.         lMax = WorksheetFunction.Match(WorksheetFunction.Max(arrTemp), arrTemp, False)
  57.         arrTemp = objDicX.keys
  58.         arrResult(5, 1) = objDicX(arrTemp(lMin - 1))
  59.         arrResult(6, 1) = objDicX(arrTemp(lMax - 1))
  60.     End If
  61.    
  62.     'Y值最大小值
  63.     If objDicY.Count Then
  64.         arrTemp = objDicY.keys
  65.         For i = LBound(arrTemp) To UBound(arrTemp)
  66.             arrTemp(i) = Val(arrTemp(i))
  67.         Next
  68.         
  69.         lMin = WorksheetFunction.Match(WorksheetFunction.Min(arrTemp), arrTemp, False)
  70.         lMax = WorksheetFunction.Match(WorksheetFunction.Max(arrTemp), arrTemp, False)
  71.         arrTemp = objDicY.keys
  72.         arrResult(7, 1) = objDicY(arrTemp(lMin - 1))
  73.         arrResult(8, 1) = objDicY(arrTemp(lMax - 1))

  75.     End If
  76.     Range("e1").Resize(UBound(arrResult), 1).Value = arrResult
  77. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
fangniuji + 3 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2013-6-22 21:28 | 显示全部楼层
hwc2ycy 发表于 2013-6-22 20:54
X,Y值都是数字不足6位在后面补0么？


是的，谢谢！！！
=IF(A2="","",MID(A2,2,FIND("Y",A2)-2)&REPT("0",8-FIND("Y",A2)+(MID(A2,2,1)="-")))
=IF(A2="","",LEFT(REPLACE(A2,1,FIND("Y",A2),)&"000000",6+ISNUMBER(FIND("Y-",A2))))
我的提取坐标公式

回复

使用道具 举报

 楼主| 发表于 2013-6-22 22:07 | 显示全部楼层
fangniuji 发表于 2013-6-22 21:28
是的，谢谢！！！
=IF(A2="","",MID(A2,2,FIND("Y",A2)-2)&REPT("0",8-FIND("Y",A2)+(MID(A2,2,1)="-" ...

如果条件变一下查找：X最小Y最小，X最大Y最小，Y最大X最小，Y最大X最大，谢谢！！！不胜感激，谢谢！！！如何改谢谢。。
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-26 19:02 , Processed in 0.175391 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表