简单坐标计算

gerogewilliam

Sub find()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''坐标的查找
Dim i&, j&, d As Date
Sheets("主页").Cells(56, 7) = "ok"
     d = Time()
      x = 2
     Sheets("主页").Select
     Do While Sheets("主页").Cells(x, 7) <> "ok"
        Dim y As Variant
         y = Sheets("主页").Cells(x, 7)
     Sheets("坐标AA").Select

    Set R = Range(Cells(5, 1), Cells(24198, 1)).find("" & y)

       If Not R Is Nothing Then   '''如果没找到就退出
        R.Interior.Color = vbYellow  ''''将单元格标记并自动退出
        R.Select
        '''''''''''''''''''''''''''''''''''''''''''''''
           t = R.Row
      'MsgBox t

             Sheets("主页").Cells(x, 40) = Sheets("坐标AA").Cells(t, 5) ''''x
             Sheets("主页").Cells(x, 41) = Sheets("坐标AA").Cells(t, 6) ''''y
             Sheets("主页").Cells(x, 42) = Sheets("坐标AA").Cells(t, 7) ''''z
             Sheets("主页").Cells(x, 43) = Sheets("坐标AA").Cells(t, 12) ''''角度
             Sheets("主页").Cells(x, 44) = Sheets("坐标AA").Cells(t, 13) ''''转换角度
             Sheets("主页").Cells(x, 45) = Sheets("坐标AA").Cells(t, 14) ''''和路面转换角度
             Sheets("主页").Cells(x, 46) = Sheets("坐标AA").Cells(t, 15) ''''和路面角度
        '''''''''''''''''''''''''''''''''''''''''''''''
      'MsgBox "共计用时" & DateDiff("s", d, Time()) & "秒"
      Else
         yy = Left(y, 5)
         Set R = Range(Cells(5, 1), Cells(24198, 1)).find("" & yy)
         R.Interior.Color = vbBlue
         On Error Resume Next ''''''当错误发生时，会立刻转移到发生错误的下一行去
       '  on error resume nezt
         R.Select
         ''''''''''''''''''''''''''''''''''''''''''''''''
             t = R.Row
             If y > Cells(t, 1) Then
                  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                num1 = y - Cells(t, 1)                 ''''桩号差值
                num2 = Cells(t - 1, 1) - Cells(t, 1)   ''''整桩号之间比值
                num3 = num1 / num2                     '''得到比值
                num4 = Cells(t - 1, 5) - Cells(t, 5)  '''''x
                num5 = Cells(t - 1, 6) - Cells(t, 6) '''''y
                num6 = Cells(t - 1, 7) - Cells(t, 7) '''''z
                num7 = Cells(t - 1, 13) - Cells(t, 13) '''''
                num8 = Cells(t - 1, 12) - Cells(t, 12) '''''
                ''''''''' '''''''''''''''''''''''
                                            Sheets("主页").Cells(x, 40) = Sheets("坐标AA").Cells(t, 5) + num3 * num4 ''''x
                                            Sheets("主页").Cells(x, 41) = Sheets("坐标AA").Cells(t, 6) + num3 * num5 ''''y
                                            Sheets("主页").Cells(x, 42) = Sheets("坐标AA").Cells(t, 7) + num3 * num6 ''''z
                                            Sheets("主页").Cells(x, 43) = Sheets("坐标AA").Cells(t, 12) + num3 * num8 ''''角度
                                            Sheets("主页").Cells(x, 44) = Sheets("坐标AA").Cells(t, 13) + num3 * num7 ''''转换角度
                                            Sheets("主页").Cells(x, 45) = Sheets("坐标AA").Cells(t, 14) ''''和路面转换角度
                                            Sheets("主页").Cells(x, 46) = Sheets("坐标AA").Cells(t, 15) ''''和路面角度    '''''''和路面角度不用变
                '''''''''''''''''''''''''''''''''

         ''''''''''''''''''''''''''''''''''''''''''''''''
         ''''''''''''''''''''''''''''''''''''''''''''''

         '''''''''''''''''''''''''''''''''''''''''''''
             Else
              '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                num1 = y - Cells(t, 1)                 ''''桩号差值
                num2 = Cells(t + 1, 1) - Cells(t, 1)   ''''整桩号之间比值
                num3 = num1 / num2                     '''得到比值
                num4 = Cells(t + 1, 5) - Cells(t, 5)  '''''x
                num5 = Cells(t + 1, 6) - Cells(t, 6) '''''y
                num6 = Cells(t + 1, 7) - Cells(t, 7) '''''z
                num7 = Cells(t + 1, 13) - Cells(t, 13)  '''''
                num8 = Cells(t + 1, 12) - Cells(t, 12)  '''''
                ''''''''' '''''''''''''''''''''''
                                            Sheets("主页").Cells(x, 40) = Sheets("坐标AA").Cells(t, 5) + num3 * num4 ''''x
                                            Sheets("主页").Cells(x, 41) = Sheets("坐标AA").Cells(t, 6) + num3 * num5 ''''y
                                            Sheets("主页").Cells(x, 42) = Sheets("坐标AA").Cells(t, 7) + num3 * num6 ''''z
                                            Sheets("主页").Cells(x, 43) = Sheets("坐标AA").Cells(t, 12) + num3 * num8 ''''角度
                                            Sheets("主页").Cells(x, 44) = Sheets("坐标AA").Cells(t, 13) + num3 * num7 ''''转换角度
                                            Sheets("主页").Cells(x, 45) = Sheets("坐标AA").Cells(t, 14) ''''和路面转换角度
                                            Sheets("主页").Cells(x, 46) = Sheets("坐标AA").Cells(t, 15) ''''和路面角度    '''''''和路面角度不用变
                '''''''''''''''''''''''''''''''''
             End If
         ''''''''''''''''''''''''''''''''''''''''''''''''
         ''''''''''''''''''''''''''''''''''''''''''''''

         '''''''''''''''''''''''''''''''''''''''''''''
     ''''  MsgBox "主人，没找到"
      End If
      ''''''''''''''''''''''''''''''

   x = x + 1
   Loop
   MsgBox "共计用时" & DateDiff("s", d, Time()) & "秒"
End Sub

Sub gzhuanghaojisuan()
'''''''''主页的桩号计算
Sheets("主页").Select
Dim numb1 As Integer
numb1 = 2
Do While Cells(numb1, 7) <> "ok"
   If Cells(numb1, 8) <> "" Then
       numb2 = Cells(numb1, 8)
       Cells(numb1, 5) = Cells(numb1, 40) + numb2 * Cos(Cells(numb1, 44) - Cells(numb1, 45))
       Cells(numb1, 6) = Cells(numb1, 41) + numb2 * Sin(Cells(numb1, 44) - Cells(numb1, 45))

    Else
       numb3 = Cells(numb1, 9)
          Cells(numb1, 5) = Cells(numb1, 40) + numb3 * Cos(Cells(numb1, 44) + Cells(numb1, 45))
          Cells(numb1, 6) = Cells(numb1, 41) + numb3 * Sin(Cells(numb1, 44) + Cells(numb1, 45))
    End If

numb1 = numb1 + 1
Loop

End Sub

Sub find99999()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''坐标的查找
'''''''''''''''''''''''''''''''''''''这个是断链后的坐标计算
Dim i&, j&, d As Date
Sheets("主页").Cells(56, 7) = "ok"
     d = Time()
      x = 2
     Sheets("主页").Select
     Do While Sheets("主页").Cells(x, 7) <> "ok"
        Dim y As Variant
         y = Sheets("主页").Cells(x, 7)
        '' MsgBox "K55断链后,,断链后 ,,不填"
          Sheets("主页").Cells(6, 1).Interior.Color = vbYellow
         shifoudaunlianhou = Sheets("主页").Cells(6, 1)
      If shifoudaunlianhou = "K55断链后" Then

      ''''''K55断链后'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



                     Sheets("坐标AA").Select


    Set R = Range(Cells(20227, 1), Cells(22200, 1)).find("" & y)

       If Not R Is Nothing Then   '''如果没找到就退出
        R.Interior.Color = vbYellow  ''''将单元格标记并自动退出
        R.Select
        '''''''''''''''''''''''''''''''''''''''''''''''
           t = R.Row
      'MsgBox t

             Sheets("主页").Cells(x, 40) = Sheets("坐标AA").Cells(t, 5) ''''x
             Sheets("主页").Cells(x, 41) = Sheets("坐标AA").Cells(t, 6) ''''y
             Sheets("主页").Cells(x, 42) = Sheets("坐标AA").Cells(t, 7) ''''z
             Sheets("主页").Cells(x, 43) = Sheets("坐标AA").Cells(t, 12) ''''角度
             Sheets("主页").Cells(x, 44) = Sheets("坐标AA").Cells(t, 13) ''''转换角度
             Sheets("主页").Cells(x, 45) = Sheets("坐标AA").Cells(t, 14) ''''和路面转换角度
             Sheets("主页").Cells(x, 46) = Sheets("坐标AA").Cells(t, 15) ''''和路面角度
        '''''''''''''''''''''''''''''''''''''''''''''''
      'MsgBox "共计用时" & DateDiff("s", d, Time()) & "秒"
      Else
         yy = Left(y, 5)
         Set R = Range(Cells(20227, 1), Cells(22200, 1)).find("" & y)
         'R.Interior.Color = vbBlue
         On Error Resume Next ''''''当错误发生时，会立刻转移到发生错误的下一行去
       '  on error resume nezt
         R.Select

gerogewilliam

为啥以前的帖子都没有了呀？