好的，我是VBA的新手，也是第一次来这里。 这是我的情况，我有一个代表调查点的x，y，z坐标列表。 在列表中，每组坐标都有一个分配的特征代码。 只有两个不同的（200 =地面点）和（311 =极点基点）。 我基本上需要找到极点座标，然后找到极点半径为6英尺的所有地面点，然后将其放在新的图纸上，在这里我可以进行进一步的计算，例如确定极点基点和地面点之间的z值。 导入以下表格后，请参阅以下屏幕截图，以获取调查数据的外观。

我编写了一部分代码，通过寻找极点特征代码“ 311”来找到极点编号和坐标，然后将其粘贴到新的工作表上，但是我似乎无法弄清楚如何编写代码来找到地面点位于杆的6英尺半径内。 我知道我可以使用距离公式“ = sqrt（（a2-a1）^ 2 +（b2-b1）^ 2）”只是不确定如何编码。 任何帮助将不胜感激。

这是我的代码的第一部分： 

Sub embed_slope()
'
'
Dim P As Integer
Dim px As Long
Dim py As Long
Dim pz As Long
Dim gx As Long
Dim gy As Long
Dim gz As Long
P = 311
    For Row1 = 2 To 50
        For Row = 2 To 50
            Cells(Row, 3).Select                'search for pole feature code
            If Selection.Value = "" Then Exit For
            If Selection.Value = "311" Then
                ActiveCell.Offset(0, 8).Select      'copy pole number
                Selection.Copy
                Sheets("Data").Select
                Cells(Row1, 1).Select
                ActiveSheet.Paste                   'paste pole number on data sheet
                Sheets("Survey Input").Select
                Application.CutCopyMode = False
                ActiveCell.Offset(0, -7).Select     'copy coorinates
                Range(ActiveCell, ActiveCell.Offset(0, 2)).Copy
                Sheets("Data").Select
                Cells(Row1, 2).Select
                ActiveSheet.Paste
                Sheets("Survey Input").Select
                Application.CutCopyMode = False
            End If
        Next Row
    Next Row1
End Sub

调查数据

#1楼 票数：0

我不确定您需要做什么，但是在分析了代码之后，我猜测您想要下面的代码。 该过程将查找极点基点并将其数据复制到Data表中，然后搜索与每个极点基点相距6英尺的所有接地点，并将其数据复制到Data表中。 我使用函数fnDistance计算点之间的距离。 

Sub prcEmbedSlope()

    Dim wbWorkbook As Workbook
    Dim intBaseRow, intGroundRow As Integer
    Dim intTargetRow As Integer
    Dim dblXBase, dblYBase As Double
    Dim dblXGround, dblYGround As Double
    Dim dblDistance As Double

    Set wbWorkbook = Application.ThisWorkbook
    intTargetRow = 1

    'First loop (looking for pole base points)
    For intBaseRow = 2 To 15
        If wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 3).Value = 311 Then
            dblXBase = wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 4).Value
            dblYBase = wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 5).Value
            'Copy pole base points data to the 2nd sheet
            wbWorkbook.Worksheets("Data").Cells(intTargetRow, 1).Value = wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 1).Value
            wbWorkbook.Worksheets("Data").Cells(intTargetRow, 3).Value = wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 3).Value
            wbWorkbook.Worksheets("Data").Cells(intTargetRow, 4).Value = wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 4).Value
            wbWorkbook.Worksheets("Data").Cells(intTargetRow, 5).Value = wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 5).Value
            wbWorkbook.Worksheets("Data").Cells(intTargetRow, 6).Value = wbWorkbook.Worksheets("Survey Input").Cells(intBaseRow, 6).Value
            intTargetRow = intTargetRow + 1
            'Second loop (looking for ground points within 6 ft. distance)
            For intGroundRow = 2 To 15
                If wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 3).Value = 200 Then
                    dblXGround = wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 4).Value
                    dblYGround = wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 5).Value
                    dblDistance = fnDistance(dblXGround, dblYGround, dblXBase, dblYBase)
                    If dblDistance < 6 Then
                        'Copy ground points data to the 2nd sheet
                        wbWorkbook.Worksheets("Data").Cells(intTargetRow, 1).Value = wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 1).Value
                        wbWorkbook.Worksheets("Data").Cells(intTargetRow, 3).Value = wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 3).Value
                        wbWorkbook.Worksheets("Data").Cells(intTargetRow, 4).Value = wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 4).Value
                        wbWorkbook.Worksheets("Data").Cells(intTargetRow, 5).Value = wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 5).Value
                        wbWorkbook.Worksheets("Data").Cells(intTargetRow, 6).Value = wbWorkbook.Worksheets("Survey Input").Cells(intGroundRow, 6).Value
                        intTargetRow = intTargetRow + 1
                    End If
                End If
            Next intGroundRow
        End If
    Next intBaseRow

End Sub

Function fnDistance(ByVal dblXG As Double, ByVal dblYG As Double, _
                    ByVal dblXB As Double, ByVal dblYB As Double) As Double

fnDistance = Sqr((dblXG - dblXB) ^ 2 + (dblYG - dblYB) ^ 2)

End Function

  ask by ClintV translate from so

未解决问题？本站智能推荐：

2回复

查找所有匹配项并复制侧列的值<>“”

我有两张纸（“客户”、“订单”）。 我想通过电话号码匹配两者。 在订单表中，我有下表： 在客户表中，我有一个电话列表。 我试图循环到我的客户列中的所有数字，在订单表中找到一个匹配项，在侧列值中包含一封邮件。 我正在努力退出循环，因为我没有更改我的变量“c”，它甚至没有找到邮件，当它不在第一行时。D
2回复

在列中查找下一个红色单元格，返回该单元格的行号

我正在寻找一个函数/宏，它可以在我的工作表上的 A 列中找到下一个红色单元格。 基本上我想做的是循环遍历 A 列，每次我找到一个空单元格时，跳到下一个红色单元格并在那里继续循环。 我所需要的只是下一个红色单元格的行号，以便执行 thuis。 到目前为止我的工作是这样的： 整个表看起来是这样的： 并
1回复

最快/最优雅的方法来遍历范围以在excelVBA中查找值

美好的一天， 在我的项目中，遇到很多情况，我需要我的代码在给定范围内多次查找某个字符串，并在找到该字符串时执行许多操作。 我写了一个适合我需要的Do..Loop ，但是由于我不是最优雅的程序员（我是自学成才的），所以我想知道其他更快或更优雅的方法。 示例代码：
1回复

查找范围内的所有值并在下一个单元格中设置另一个cell.value

嗨，我正在使用宏在一系列字符串中查找单词 Flex，但我需要设置另一个值以在它旁边创建一个列。 但我无法找出遍历所有单元格直到最后一行的方法，并为找到的每个值在下一个单元格和列中设置另一个值。 结束子
1回复

ExcelVBA：逐行查找范围内的一对布尔值

我正在尝试使用vba在excel表中解决一个相当基本的问题，但我找不到答案... 我正在研究一个时间表，该时间表是从另一个具有布尔值True或False的Excel工作表中动态填充的。 命名范围在excel中称为“ A”，并且包含布尔值True或False。 每列代表一个可能的开始时间。
1回复

ExcelVBA-For循环。使用值查找单元格

我正在努力编写一个有效的宏，该宏将在列中找到一个有错误的单元格，然后将该单元格替换为第一个非空单元格的值，而该单元格下面没有错误（可能有连续的错误单元格），然后循环12列。 我下面的代码替换了所有12列中的每个错误单元格，但不是以一致的方式进行替换：某些单元格的确会被下面包含数字的下一个单元
2回复

在一定范围内更改值以避免循环，以提高速度

我有下面的代码，运行非常缓慢。 关于如何使速度更快的任何想法？ 在上一个Sub中，有一些背景知识，我选择了一个范围，然后复制并粘贴了它。 现在，我需要根据代码更改值。 是否可以采用此范围并对其进行修改而不先粘贴？
2回复

选择下一个唯一值

我想将数据从一列复制到另一张纸上的列。 第一张纸上有一个ID号列表（从F3开始），紧挨着时钟的进出时间。 在转移到下一位雇员之前，将有5到31个ID号条目。 第二页是一个每天有一行的时间表。 每位员工的第一行都是空白（从C8开始），该行的数据余额（姓名，行业，场所等）是对此空白单元格