使用Excel中的VBA工具拆分坐标

本文迁移自本人网易博客，写于2013年5月23日

目标：将59994.801012,30025.194515,0.000000;62607.167162,30025.194515,0.000000;62607.167162,27874.610706,0.000000;59994.801012,27874.610706,0.000000;

格式的坐标，拆分后，返回如下所示xml格式：

- <ZB>

<BH>0</BH>

<X>59994.801012</X>

<Y>30025.194515</Y>

</ZB>

- <ZB>

<BH>1</BH>

<X>62607.167162</X>

<Y>30025.194515</Y>

</ZB>

- <ZB>

<BH>2</BH>

<X>62607.167162</X>

<Y>27874.610706</Y>

</ZB>

- <ZB>

<BH>3</BH>

<X>59994.801012</X>

<Y>27874.610706</Y>

</ZB>

首先将要分隔的坐标放置在数据表的第一行第一列；

过程分析：先以分号分隔各坐标，再用逗号分隔各坐标，最后连接字符串；

函数源代码如下：

Public Sub 拆分坐标()

Dim reg As Object

Dim x, y, z, ar(1 To 100), ar_x(1 To 100), ar_y(1 To 100), ar_z(1 To 100)

Dim arr, arr_x, arr_y, arr_z As Variant

Dim nIndex As Integer

Dim m, n, k, r

Dim retStr, bh As String

Set reg = CreateObject("VBScript.RegExp")

With reg

.Global = True

.Pattern = "[^;]+;"

Set x = .Execute(Cells(1, 1))

For Each y In x

z = z + 1

ar(z) = y

nIndex = InStr(1, y, ",", 0)

m = Left(y, nIndex - 1)

r = Mid(y, nIndex + 1)

nIndex = InStr(1, r, ",", 0)

n = Left(r, nIndex - 1)

r = Mid(r, nIndex + 1)

nIndex = InStr(1, r, ";", 0)

k = Left(r, nIndex - 1)

ar_x(z) = m

ar_y(z) = n

ar_z(z) = k

bh = z - 1

retStr = retStr + "<ZB>" + "<BH>" + bh + "</BH>" + "<X>" + m + "</X>" + "<Y>" + n + "</Y>" + "</ZB>"

Next

End With

arr = WorksheetFunction.Transpose(ar)

arr_x = WorksheetFunction.Transpose(ar_x)

arr_y = WorksheetFunction.Transpose(ar_y)

arr_z = WorksheetFunction.Transpose(ar_z)

Cells(2, 1).ClearContents

Cells(2, 1).Value = retStr

Columns(2).ClearContents

Cells(1, 2).Resize(z, 1) = arr

Columns(3).ClearContents

Cells(1, 3).Resize(z, 1) = arr_x

Columns(4).ClearContents

Cells(1, 4).Resize(z, 1) = arr_y

Columns(5).ClearContents

Cells(1, 5).Resize(z, 1) = arr_z

End Sub