将单元格内容拆分/复制/移动到预定/对应的列

Question

我有以下情况。在Excel工作表中，我有一列，其中包含用“ |”分隔的值。 例如

gluUnproject

我想

int glhUnProjectf(float winx, float winy, float winz,
    float* modelview, float* projection, int* viewport, float* objectCoordinate)
{
    // Transformation matrices
    float m[16], A[16];
    float in[4], out[4];
    // Calculation for inverting a matrix, compute projection x modelview
    // and store in A[16]
    MultiplyMatrices4by4OpenGL_FLOAT(A, projection, modelview);
    // Now compute the inverse of matrix A
    if(glhInvertMatrixf2(A, m)==0)
       return 0;
    // Transformation of normalized coordinates between -1 and 1
    in[0]=(winx-(float) viewport[0])/(float) viewport[2]*2.0-1.0;
    in[1]=(winy-(float) viewport[1])/(float) viewport[3]*2.0-1.0;
    in[2]=2.0* winz-1.0;
    in[3]=1.0;
    // Objects coordinates
    MultiplyMatrixByVector4by4OpenGL_FLOAT(out, m, in);
    if(out[3]==0.0)
       return 0;
    out[3]=1.0/out[3];
    objectCoordinate[0]=out[0]*out[3];
    objectCoordinate[1]=out[1]*out[3];
    objectCoordinate[2]=out[2]*out[3];
    return 1;
}

这是我目前用于实现它的代码：

Option Column
Option 1 | Option 3
Option 4 | Option 7
Option 2 | Option 3 | Option 6

我只是想知道循环是否是解决问题的最佳方法，特别是因为当我开始使用它时，我将要处理20,000+行和15+列。

Answer 1

在拆分单元格内容时，您将需要一个循环来遍历。遍历数组比遍历工作表更快。拆分后，在将目标数组值放入工作表之前，用匹配的列填充目标数组。

Option Explicit

Sub InsertOptions()

    Dim i As Long, j As Long, mx As Long, dlm As String
    Dim hdrs As Variant, opts As Variant, vals As Variant, tmp As Variant, m As Variant

    dlm = " | "   'column A delimiter; might be " | "
    mx = 15       'maximum number of options

    With Worksheets("sheet9")

        'create an independent array of header labels
        ReDim hdrs(1 To 1, 1 To mx)
        For i = LBound(hdrs, 2) To UBound(hdrs, 2)
            hdrs(1, i) = "Option " & i
        Next i

        'collect the delimited options from column A
        opts = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Value2

        'make room for all options in expanded form
        ReDim vals(LBound(opts, 1) To UBound(opts, 1), _
                   LBound(hdrs, 2) To UBound(hdrs, 2))

        'loop through delimited options, split them and look for matches in hdrs
        For i = LBound(opts, 1) To UBound(opts, 1)
            tmp = Split(opts(i, 1), dlm)
            For j = LBound(tmp) To UBound(tmp)
                m = Application.Match(tmp(j), hdrs, 0)
                If Not IsError(m) Then
                    vals(i, m) = tmp(j)
                End If
            Next j
        Next i

        'insert ten new columns
        .Cells(1, "B").Resize(1, UBound(hdrs, 2)).EntireColumn.Insert

        'put arrays into new columns
        With .Cells(1, "B").Resize(1, UBound(hdrs, 2)).EntireColumn
            .ColumnWidth = 9
            .Cells(1, 1).Resize(UBound(hdrs, 1), UBound(hdrs, 2)) = hdrs
            .Cells(2, 1).Resize(UBound(vals, 1), UBound(vals, 2)) = vals
        End With
    End With

End Sub

Answer 2

Variant using System.Collections.ArrayList and Scripting.Dictionary, I guess that should be faster than your solution)

Sub test()
    Dim data As Range, cl As Range, i&, x As Variant
    Dim arrList As Object, Dic As Object
    Set arrList = CreateObject("System.Collections.ArrayList")
    Set Dic = CreateObject("Scripting.Dictionary")
    Set data = Range([A2], Cells(Rows.Count, "A").End(xlUp))

    'get unique values from split
    For Each cl In data
        For Each x In Split(cl, "|"): x = Trim(x)
            If Not Dic.exists(x) Then
                Dic.Add x, Nothing
                arrList.Add x
            End If
    Next x, cl

    Dic.RemoveAll        'clear dictionary

    arrList.Sort         'sort values
    If sortorder = xlDescending Then
        arrList.Reverse
    End If

    'add headers
    i = 2
    For Each x In arrList
        Cells(1, i).Value2 = x
        Dic.Add x, i: i = i + 1
    Next x
    'split values against headers
    For Each cl In data
        For Each x In Split(cl, "|"): x = Trim(x)
            Cells(cl.Row, Dic(x)).Value2 = x
    Next x, cl
End Sub

test here