[已解决]求教，我这段代码到底有什么原因？（更新附件）

lovelfg

现在有一列数据，存放的是电话号码，有一些单元格内包含了两个或者两个以后的号码，这些号码之间以“/”隔开。现想把有三个或者三个以上的号码分为两列，第一列保持一个号码，第二列存放第二个和第三个甚至更多的电话号码，我编写了一段代码，但是运行后一点效果也没有，不知道是什么原因，请高人帮我看一下吧

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2016-9-9 11:43

1. Sub test()
   
2. Dim arr, brr
   
3. arr = Range("a1").CurrentRegion
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For a = 2 To UBound(arr)
   
6.     x = InStr(arr(a, 1), "/")
   
7.     If x = 0 Then
   
8.         brr(a, 1) = arr(a, 1)
   
9.     Else
   
10.         brr(a, 1) = Left(arr(a, 1), x - 1)
    
11.         brr(a, 2) = Mid(arr(a, 1), x + 1)
    
12.     End If
    
13. Next
    
14.     [b1].Resize(a - 1, 2) = brr
    
15. End Sub

复制代码

跳转到最佳答案楼层

Excel学徒123

复制代码吧

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.     Dim arrSrc, arr, arrRst()
   
5.     Dim irow%, iCnt%
   
6.     Dim strText$
   
7.     arrSrc = Range("a1").CurrentRegion.Value
   
8.     ReDim arrRst(1 To UBound(arrSrc), 1 To 2)
   
9.     For irow = 2 To UBound(arrSrc)
   
10.         arr = Split(arrSrc(irow, 1), "/")
    
11.         If UBound(arr) = 1 Or UBound(arr) = 0 Then
    
12.             arrRst(irow, 1) = arrSrc(irow, 1)
    
13.         End If
    
14.         If UBound(arr) > 1 Then
    
15.             arrRst(irow, 1) = arr(0)
    
16.             For iCnt = 1 To UBound(arr)
    
17.                 If Len(arr(iCnt)) > 0 Then
    
18.                     strText = strText & arr(iCnt) & "/"
    
19.                 End If
    
20.             Next
    
21.         End If
    
22.         If Len(strText) > 0 Then
    
23.             arrRst(irow, 2) = Left(strText, Len(strText) - 1)
    
24.         End If
    
25.         strText = ""
    
26.     Next
    
27.     Range("g1").Resize(UBound(arrRst), 2) = arrRst
    
28. End Sub
    

复制代码

gufengaoyue

1. Sub test()
   
2. Dim arr, brr
   
3. arr = Range("a1").CurrentRegion
   
4. ReDim brr(1 To UBound(arr), 1 To 2)
   
5. For a = 2 To UBound(arr)
   
6.     x = InStr(arr(a, 1), "/")
   
7.     If x = 0 Then
   
8.         brr(a, 1) = arr(a, 1)
   
9.     Else
   
10.         brr(a, 1) = Left(arr(a, 1), x - 1)
    
11.         brr(a, 2) = Mid(arr(a, 1), x + 1)
    
12.     End If
    
13. Next
    
14.     [b1].Resize(a - 1, 2) = brr
    
15. End Sub

复制代码

lovelfg

多谢两位！

苏子龙

根据您要求更改下代码，是直接取得数后再判断。
Sub test()
    Dim x As Integer, arr
    [g:h] = ""
    For x = 2 To 13
        arr = Split(Range("A" & x), "/")
        If UBound(arr) = 1 Then
            Range("g" & x) = arr(0) & "/" & arr(1)
        Else
            Range("g" & x) = arr(0)
            Range("h" & x) = Mid(Replace(Join(arr, "/"), arr(0), ""), 2)
        End If
        arr = ""
    Next x
End Sub

lovelfg

苏子龙 发表于 2016-9-9 12:36
根据您要求更改下代码，是直接取得数后再判断。
Sub test()
    Dim x As Integer, arr

万分感谢！您的这个对我很有参考意义，我才明白自己错在哪儿

小小水皮1

因为它是个二维数组
Sub djk()
Dim arr, k%, i%
arr = Range("a2", Cells(Cells.Rows.Count, 1).End(xlUp))
For i = 1 To UBound(arr)
    k = Len(arr(i, 1))
        If k > 8 Then
        Cells(i + 1, "e") = Left(arr(i, 1), 8)
      
        Cells(i + 1, "f") = Right(arr(i, 1), Len(arr(i, 1)) - 9)
        Else
         Cells(i + 1, "e") = Left(arr(i, 1), 8)
        End If
    Next
End Sub