Thanks in advance for help!
Code: Select all
Sub test()
arr = [a1].CurrentRegion
crr = Split("地点,内容,备注", ",")
x = UBound(arr)
For j = UBound(arr) To 1 Step -1
If arr(j, 1) = "序号" Then
For i = 0 To UBound(crr)
For l = 1 To UBound(arr, 2)
If arr(j, l) = crr(i) Then
For k = j To x
tm = arr(k, l)
arr(k, l) = arr(k, i + 2)
arr(k, i + 2) = tm
Next k
End If
Next l
Next i
x = j - 1
End If
Next j
Sheets(2).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
Code: Select all
oExcel := ComObjActive("Excel.Application")
arr := [A1].CurrentRegion
crr := StrSplit("地点,内容,备注", ",")
x := UBound(arr)
j := UBound(arr)
i := 0
l := 1
while (j>=1)
{
If(arr[j, 1] = "序号")
{
while (i<=UBound(crr))
{
while (l<=UBound(arr, 2))
{
If(arr[j, l] = crr[i])
{
k := j
while (k<=x)
{
tm := arr[k, l]
arr[k, l] := arr[k, i + 2]
arr[k, i + 2] := tm
k:=k+1
}
}
l:=l+1
}
i:=i+1
}
x := j - 1
}
j:=j-1
}
oExcel.ActiveWorkbook.Sheets(2).[A1].Resize(UBound(arr), UBound(arr, 2)) := arr
return