提取数据到指定区域

天地一相

感谢帮助！详见截图附件。

jz_l

liulang0808

直接分列是否可行？

天地一相

liulang0808 发表于 2023-1-3 21:01
直接分列是否可行？

谢，不行。表头有内容

gwjkkkkk

请楼主参考附件。。。

liulang0808

天地一相 发表于 2023-1-3 21:06
谢，不行。表头有内容

把需要拆分的数据选定，然后分列

wxxydl

Sub 分列()
      Dim imax
      Dim arr, outarr
      Dim acsht
      Set acsht = ActiveSheet
      With acsht
            imax = .[a4].End(xlDown).Row
            ReDim outarr(1 To imax - 3, 1 To 7)
            arr = .Range("A4:A" & imax)
            For i = 1 To UBound(arr)
                 ar = Split(arr(i, 1), ",")
                 For j = 1 To 7
                   outarr(i, j) = ar(j - 1)
                  Next
            Next
           .Range("B4").Resize(UBound(outarr), UBound(outarr, 2)) = outarr
      End With
End Sub

wxxydl

我简单地做了一下

liulang0808

Sub Macro1()
    Application.DisplayAlerts = False
    Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).TextToColumns Destination:=Range("A4"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
    Application.DisplayAlerts = True
End Sub

天地一相

wxxydl 发表于 2023-1-3 21:52
Sub 分列()
      Dim imax
      Dim arr, outarr

谢谢！有个潜在的故障，若原始数据的分隔符号是其它样式或者是多种多样的，就会出问题。可否定义只要符号就视为分隔符号，或者，直接定义取值位数和个数。

wxxydl

天地一相 发表于 2023-1-4 12:11
谢谢！有个潜在的故障，若原始数据的分隔符号是其它样式或者是多种多样的，就会出问题。可否定义只要符号 ...

举例说明