Question

我有一个电子表格，其中包含一列，其数据如下所示：

数据; X = 7.9; Y = 9.1; Z = 2; V = 4; G = 8

我想做的基本上是忽略'Data;'，然后除了将标识符（X，Y，Z，V或G）添加为列之外，在右侧创建具有相关值的新列标头。然后删除数据字符串来自的原始列。

我尝试使用“文本到列”来执行此操作，但是它将数据放置在像这样的单元格中：X = 7.9等。当我想要在字段中以此类推7.9时，以此类推，顶部（标题）第一个单元格包含X，Y，Z，V或G。

我想我也许以后可以使用分割文本，但是如果可能的话，这时最好在vba中使用。

我尝试了这个，但是无法使其工作；而不是|，但我不确定是否还会添加列标题，因此可能不是我想要的。

DECLARE @t table (
   piped varchar(50)
)

INSERT INTO @t (piped)
  VALUES ('pipe|delimited|values')
       , ('a|b|c');

; WITH x AS (
  SELECT piped
       , CharIndex('|', piped) As first_pipe
  FROM   @t
)
, y AS (
  SELECT piped
       , first_pipe
       , CharIndex('|', piped, first_pipe + 1) As second_pipe
       , SubString(piped, 0, first_pipe) As first_element
  FROM   x
)
, z AS (
  SELECT piped
       , first_pipe
       , second_pipe
       , first_element
       , SubString(piped, first_pipe  + 1, second_pipe - first_pipe - 1) As second_element
       , SubString(piped, second_pipe + 1, Len(piped) - second_pipe) As third_element
  FROM   y
)
SELECT *
FROM   z

Answer 1

也许您可以使用字典尝试以下代码。这很混乱，可能可以用更简单的方式完成，但似乎可行。只需编辑数据范围行即可。

Option Explicit
Sub DataRange()
    Dim DataRange As Range
    Dim DataSheet As Worksheet
    Dim c As Range
    Dim DataString As String
    Dim DataDictionary As Object 'SCRIPTING.DICTIONARY
    Dim TargetColumns As Object 'SCRIPTING.DICTIONARY
    Dim TargetColumn As Long
    Dim Key As String
    Dim TargetAddress As String

    Dim xlCurrentCalculation As XlCalculation
    Dim i As Long
    TargetColumn = 2

    xlCurrentCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual
'#############################################################################################
    Set DataRange = ActiveSheet.Range("A2:A21") 'EDIT THIS LINE WITH ACTUAL DATA ADDRESS
'#############################################################################################
    Set DataSheet = DataRange.Parent
    Set TargetColumns = CreateObject("SCRIPTING.DICTIONARY")
    For Each c In DataRange
        DataString = CStr(c)
        Set DataDictionary = DataStringToDataDictionary(DataString)
        For i = 0 To DataDictionary.Count - 1
            Key = DataDictionary.keys()(i)
            If Not TargetColumns.exists(Key) Then
                TargetColumns.Add Key, TargetColumn
                TargetColumn = TargetColumn + 1
            End If
            TargetAddress = TargetColumns(Key) & c.Row
            DataSheet.Cells(c.Row, TargetColumns.Item(Key)) = DataDictionary.items()(i)
        Next i
    Next c
    For i = 0 To TargetColumns.Count - 1
        DataSheet.Cells(1, TargetColumns.items()(i)) = TargetColumns.keys()(i)
    Next i

    'Uncomment the following line to delete the column of the data containing the range.
    'It will create an offset in written data though
    'DataRange.EntireColumn.Delete
    Application.Calculate
    Application.Calculation = xlCalculationAutomatic
End Sub
Function DataStringToDataDictionary(DataString As String)

    Dim DataArray() As String
    Dim DataSubArray() As String
    Dim DataDictionary As Object 'SCRIPTING.DICTIONARY
    Dim Key As String
    Dim Value As String
    Dim i As Long

    DataArray = Split(DataString, ";")
    'We ignore first element of the array, as we assume it contains the word "Data"

    Set DataDictionary = CreateObject("SCRIPTING.DICTIONARY")
    For i = 1 To UBound(DataArray)
        DataSubArray = Split(DataArray(i), "=")
        Key = DataSubArray(0)
        Value = DataSubArray(1)
        DataDictionary.Add Key, Value
    Next i

    Set DataStringToDataDictionary = DataDictionary

End Function

编辑：

If the previous code does not work, you could also try the following :


Sub SplittingDataWithoutDictionary()
    Dim DataRange As Range
    Dim DataSheet As Worksheet
    Dim c As Range
    Dim DataArray() As String
    Dim DataSubArray() As String
    Dim HeadersLabels() As Variant
    Dim i As Long
    Dim FirstWriteBackColumn As Long
    Dim Index As Long
    Dim Value As String

    Dim xlCurrentCalculation As XlCalculation

    xlCurrentCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual


    HeadersLabels = Array("X", "Y", "Z", "V", "G")

    Set DataRange = ActiveSheet.Range("A2:A20") 'Edit with the actual range you want to split
    Set DataSheet = DataRange.Worksheet
    FirstWriteBackColumn = 2 'Edit with the first column in which you want to write back data

    For Each c In DataRange
        DataArray = Split(CStr(c), ";")
        For i = 1 To UBound(DataArray)
            DataSubArray = Split(DataArray(i), "=")
            Index = FetchIndexInArray(HeadersLabels, DataSubArray(0))
            Value = DataSubArray(1)
            DataSheet.Cells(c.Row, FirstWriteBackColumn + Index) = Value
        Next i
    Next c
    For i = 0 To UBound(HeadersLabels)
        DataSheet.Cells(1, i + FirstWriteBackColumn) = HeadersLabels(i)
    Next i
    'Datarange.entirecolumn.delete
    Application.Calculation = xlCurrentCalculation
End Sub

Function FetchIndexInArray(StringArray() As Variant, LookFor As String) As Long
    Dim i As Long

    For i = LBound(StringArray) To UBound(StringArray)
        If StringArray(i) = LookFor Then
            FetchIndexInArray = i
            Exit Function
        End If
    Next i
End Function

如何将具有多个值（定界）的单元格列分隔为新列并添加标头

1 个答案: