[已解决]替代原来的坐标

fangniuji · 发表于 2017-4-23 11:55

本帖最后由 fangniuji 于 2017-4-25 11:55 编辑

帮忙写个代码，把B列含有G85的坐标 G85去掉，如B6 结果C6和D6 然后变成两个坐标重新排位，替代原来的坐标，最后A列数据源的结果如E列。然后再用2 和 3 页的A，B列数据源执行一下代码结果A列和E列结果一样。

最佳答案

月排行榜 / 总排行榜

grf1973

2017-4-24 09:59

Sub tt()
arr = Range("a1:a" & [a65536].End(3).Row)
ReDim brr(1 To 2 * UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If InStr(arr(i, 1), "G85") = 0 Then
n = n + 1
brr(n, 1) = arr(i, 1)
Else
xrr = Split(arr(i, 1), "G85")
For k = 0 To 1
x = xrr(k): p = Len(Replace(x, "-", ""))
If p < 14 Then x = x & Application.WorksheetFunction.Rept("0", 14 - p) '不满14位的，用0补足
n = n + 1
brr(n, 1) = x
Next
End If
Next
[s1].Resize(n, 1) = brr
End Sub

复制代码

跳转到最佳答案楼层

grf1973 · 发表于 2017-4-24 09:59

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

Sub tt()
arr = Range("a1:a" & [a65536].End(3).Row)
ReDim brr(1 To 2 * UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If InStr(arr(i, 1), "G85") = 0 Then
n = n + 1
brr(n, 1) = arr(i, 1)
Else
xrr = Split(arr(i, 1), "G85")
For k = 0 To 1
x = xrr(k): p = Len(Replace(x, "-", ""))
If p < 14 Then x = x & Application.WorksheetFunction.Rept("0", 14 - p) '不满14位的，用0补足
n = n + 1
brr(n, 1) = x
Next
End If
Next
[s1].Resize(n, 1) = brr
End Sub

复制代码

fangniuji · 发表于 2017-4-25 11:48

本帖最后由 fangniuji 于 2017-4-25 11:57 编辑

grf1973 发表于 2017-4-24 09:59

昨天一直进不来系统，抱歉！我表达有问题：正确是；帮忙写个代码，把B列含有G85的坐标 G85去掉，如B6 结果C6和D6 然后变成两个坐标重新排位，替代原来的坐标，最后A列数据源的结果如E列。然后再用2 和 3 页的A，B列数据源执行一下代码结果2 页 A列和B列和2页的 E列结果要一样，同理 3页也一样，谢谢。
代码基本上OK，再帮我改改! 谢谢只替代B列含有G85的坐标，B列没有的，不做变化。

fangniuji · 发表于 2017-4-25 12:04

grf1973 发表于 2017-4-24 09:59

把B列含有G85的坐标 G85去掉，B列不含G85的坐标，结果 G85不去掉。

grf1973 · 发表于 2017-4-25 13:45

反正你的描述我看不懂。我是根据模拟结果自己琢磨出来的。

fangniuji · 发表于 2017-4-25 13:51

grf1973 发表于 2017-4-25 13:45
反正你的描述我看不懂。我是根据模拟结果自己琢磨出来的。

谢谢！

		自动登录	找回密码
密码			注册