Excel VBA: 创建坐标系并填充高度值

使用Excel VBA创建坐标系并填充高度值

本文提供Excel VBA代码，用于将Sheet1中包含高度值及对应X、Y轴坐标的数据，创建新的工作表并按照坐标系排列，将高度值填入对应单元格。

前提条件:

在Excel的Sheet1中有三列数据，分别为高度值及其对应的X，Y轴坐标，其中第一列为X轴坐标，第二列为Y轴坐标，第三列为高度值。

**代码:**vbaSub CreateCoordinateSystem() Dim srcSheet As Worksheet Dim destSheet As Worksheet Dim lastRow As Long Dim xRange As Range Dim yRange As Range Dim heightRange As Range Dim i As Long, j As Long ' 设置源工作表 Set srcSheet = ThisWorkbook.Sheets('Sheet1') ' 创建新的工作表 Set destSheet = ThisWorkbook.Sheets.Add(After:=srcSheet) destSheet.Name = 'CoordinateSystem' ' 获取源数据的最后一行 lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row ' 设置X轴坐标范围 Set xRange = srcSheet.Range('A2:A' & lastRow) ' 设置Y轴坐标范围 Set yRange = srcSheet.Range('B2:B' & lastRow) ' 设置高度值范围 Set heightRange = srcSheet.Range('C2:C' & lastRow) ' 将X轴坐标按照从小到大排序 xRange.Sort Key1:=xRange, Order1:=xlAscending, Header:=xlNo ' 将Y轴坐标按照从大到小排序 yRange.Sort Key1:=yRange, Order1:=xlDescending, Header:=xlNo ' 在新工作表中建立坐标系 For i = 1 To xRange.Rows.Count destSheet.Cells(1, i + 1).Value = xRange.Cells(i, 1).Value Next i For j = 1 To yRange.Rows.Count destSheet.Cells(j + 1, 1).Value = yRange.Cells(j, 1).Value Next j ' 将高度值填入对应的单元格中 For i = 1 To xRange.Rows.Count For j = 1 To yRange.Rows.Count If srcSheet.Cells(j + 1, i).Value = destSheet.Cells(j + 1, 1).Value And _ srcSheet.Cells(j + 1, i + 1).Value = destSheet.Cells(1, i + 1).Value Then destSheet.Cells(j + 1, i + 1).Value = heightRange.Cells(j, 1).Value End If Next j Next i ' 格式化坐标系 destSheet.Activate destSheet.Cells.Select Selection.ColumnWidth = 10 Selection.RowHeight = 15 MsgBox '新的工作表已创建并按要求排列完成。'End Sub

使用方法:

打开Excel文件并按下Alt + F11打开VBA编辑器。2. 在VBA编辑器中，选择要运行代码的工作簿。3. 在菜单栏中选择插入 > 模块，在新建的模块中粘贴上述代码。4. 按下Ctrl + S保存修改。5. 按下F5运行宏。一旦代码完成执行，将创建名为'CoordinateSystem'的新工作表，并按照您的要求进行排列。

注意:

确保在运行宏之前，在Excel的'Sheet1'中确实存在数据，并且没有名为'CoordinateSystem'的工作表，以避免冲突。

希望以上代码能帮到您！