M1-M5这种格式有几种方法实现拆分

djz2zyf

大家好
    附件这种格式有几种方法实现拆分
        开动大伙的思维。。。。。。

zhaogang1960

试试看
Sub Macro1()
    Dim arr, a, temp$, i&, j%, m1%, m2%, fc%, lc%
    arr = Range("E2:E" & Range("b65536").End(xlUp).Row)
    For i = 1 To UBound(arr)
        If InStr(arr(i, 1), "-") Then
            a = Split(arr(i, 1), "-")
            For j = 1 To Len(a(0))
                If IsNumeric(Mid(a(0), j, 1)) Then
                    m1 = j
                    Exit For
                End If
            Next
            s = Left(a(0), m1 - 1)
            fc = Right(a(0), Len(a(0)) - m1 + 1)
            For j = 1 To Len(a(1))
                If IsNumeric(Mid(a(0), j, 1)) Then
                    m2 = j
                    Exit For
                End If
            Next
            lc = Right(a(1), Len(a(1)) - m2 + 1)
            temp = ""
            For j = fc To lc
                temp = temp & " " & s & j
            Next
            arr(i, 1) = Trim(temp)
        End If
    Next
    Range("E2:E" & Range("b65536").End(xlUp).Row) = arr
End Sub

djz2zyf

多谢您的解答

djz2zyf

您好  M1-M210就分不了
  是不是您定义了还是？

zhaogang1960

我可没有这个能力，这是字符数超过了255个的限制，使用数组写入可能会出错，Y1-Y210生成的字符串字符数已经达到941个：
下面代码逐个单元格写入，请测试
Sub Macro1()
    Dim arr, a, temp$, i&, j%, m1%, m2%, fc%, lc%
    arr = Range("E2:E" & Range("b65536").End(xlUp).Row)
    For i = 1 To UBound(arr)
        If InStr(arr(i, 1), "-") Then
            a = Split(arr(i, 1), "-")
            For j = 1 To Len(a(0))
                If IsNumeric(Mid(a(0), j, 1)) Then
                    m1 = j
                    Exit For
                End If
            Next
            s = Left(a(0), m1 - 1)
            fc = Right(a(0), Len(a(0)) - m1 + 1)
            For j = 1 To Len(a(1))
                If IsNumeric(Mid(a(0), j, 1)) Then
                    m2 = j
                    Exit For
                End If
            Next
            lc = Right(a(1), Len(a(1)) - m2 + 1)
            temp = ""
            For j = fc To lc
                temp = temp & " " & s & j
            Next
            arr(i, 1) = Trim(temp)
        End If
    Next
'    Range("E2:E" & Range("b65536").End(xlUp).Row) = arr
    For i = 1 To UBound(arr)
        Cells(i + 1, 5) = arr(i, 1)
    Next
End Sub

djz2zyf

十分感谢您的解答
   因本人对VBA刚刚开始接触，很多地方不懂有什么说错了的地方 还请见谅。。

djz2zyf

您好  小声的问一下 temp$, i&, j%, m1%, m2%, fc%, lc%

代表什么意思。。

djz2zyf

你好 感谢你的解答。。。
对那种格式稍微变动一下，该如何实现。
详情见附件

[ 本帖最后由 djz2zyf 于 2010-1-30 21:17 编辑 ]

zhaogang1960

请测试：
Sub Macro1()
    Dim a, b, arr, brr(), m&, i&, j&, k&, l&, a1&, a2&
    arr = Range("e2:E" & Range("e65536").End(xlUp).Row)
    For i = 1 To UBound(arr)
        a = Split(arr(i, 1), "，")
        m = 0
        For j = 0 To UBound(a)
            If InStr(a(j), "-") Then
                b = Split(a(j), "-")
                For k = 1 To Len(b(0))
                    If IsNumeric(Mid(b(0), k, 1)) Then
                        a1 = Mid(b(0), k)
                        temp = Left(b(0), k - 1)
                        Exit For
                    End If
                Next
                For k = 1 To Len(b(1))
                    If IsNumeric(Mid(b(1), k, 1)) Then
                        a2 = Mid(b(1), k)
                        Exit For
                    End If
                Next
                For k = a1 To a2
                    m = m + 1
                    ReDim Preserve brr(1 To m)
                    brr(m) = temp & k
                Next
            Else
                m = m + 1
                ReDim Preserve brr(1 To m)
                brr(m) = a(j)
            End If
        Next
        arr(i, 1) = Join(brr, " ")
        Erase brr
    Next
    Range("e2:E" & Range("e65536").End(xlUp).Row) = arr
End Sub

[ 本帖最后由 zhaogang1960 于 2010-1-30 22:24 编辑 ]

djz2zyf

多谢你的帮助。。对我的工作很有帮助。
还有几个地方希望您能帮忙完善下。。。比如 拆分之后 数量的统计能否更新。因为前面的QTY是手工输入有时候并不准确。 根据拆分之后统计的数量更准确些。
中间的逗号，能不能改成自动识别的。 有时候逗号会用点（.) 斜杠（/）或者反斜杠（\)分号：或；空格
谢谢

[ 本帖最后由 djz2zyf 于 2010-1-31 10:36 编辑 ]