Небольшие критические замечания (не стоит понижать голосование): 1 / Вы удаляете все пробелы в поле (например, «Боб, Джилл Смит, Джордж» становится «Боб», «Джиллсмит», «Джордж»). 2 / Ваше "удалить слева" лучше, чем "output_str = mid (output_str, 2)". Кроме этого и АН, кажется, все в порядке.

я есть следующие данные в Excel:

a, b, c
d
e
f, g
h
i

с каждой строкой, представляющей строку и в одной ячейке.

Я хотел бы преобразовать его в:

a
b
c
d
e
f
g
h
i

Я использую следующий макрос, но я не могу получить авторазмер для вставки, вместо переопределения значений ячеек. Любая помощь приветствуется.

    Sub SplitCells()


    Dim i As Long



    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False




    For i = 1 To Selection.Rows.Count

        Dim splitValues As Variant


        splitValues = split(Selection.Rows(i).Value, ",")

        Selection.Rows(i).Resize(UBound(splitValues) - LBound(splitValues) + 1).Value = Application.Transpose(splitValues)

    Next i



        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub

Ответы на вопрос(3)

но это алгоритмический шаблон, который я использовал много раз. Это было какое-то время, поэтому не стоит доверять синтаксису.

sub SplitCells()  
    Dim c as Range      ' iterator for cells in Selection  
    dim r as Range      ' to hold the range which is the first cell in Selection  
    Dim r2 as Range     ' variable range for single cell which is the target for inserting the result  
    Dim a() a Variant   ' array of variants to hold each cell's value after it's split  
    Dim b() as Variant  ' array of variants to hold the accumulation of values to spread into the destination  
    Dim v ar Variant    ' variant to iterate through b for insertion  
    Dim i as Integer    ' cumulative offset from top of destination range while inserting  

    For each c in Selection.Cells  
        a = Split(Replace(c.Text, ",", "")) ' will split on whitespace  
        for each v in a  
            b.Add v  
        next v  
    next c  

    ' now you have a new array with the full set of values  

    ' insert them a row at a time using Range.Offset  
    i = 0  
    Set r = Selection.Cells(0)  
    For Each v in b  
        Set r2 = r.Offset(1, 0)  
        r2.Value = v  
        i = i + 1  
    next v  
End Sub  
 paxdiablo23 янв. 2009 г., 14:00
Вы знаете, что получаете синтаксическую ошибку в "Dim a () Variant", не так ли? Я не знаю, что с ним не так, я никогда не использовал варианты или массивы в VBA (мои массивы обычно хранятся в ячейках Excel :-).
Решение Вопроса

B. Результаты показаны ниже, не стесняйтесь использовать мои навыки графического представления :-)

    <- A ->   <- B ->
1   a, b, c   a
2   d         b
3   e         c
4   f, g      d
5   h         e
6   i         f
7             g
8             h
9             i

Я оставил его как неразрушающий для целей тестирования, и поскольку относительно легко создать новый столбец, заполните его и удалите старый столбец в VBA. Упражнение для читателя ...

Вот макрос:

Option Explicit
Sub Macro1()
    Dim fromCol As String
    Dim toCol As String
    Dim fromRow As String
    Dim toRow As String
    Dim inVal As String
    Dim outVal As String
    Dim commaPos As Integer

    ' Copy from column A to column B.'
    fromCol = "A"
    toCol = "B"
    fromRow = "1"
    toRow = "1"

    ' Go until no more entries in column A.'
    inVal = Range(fromCol + fromRow).Value
    While inVal <> ""

        ' Go until all sub-entries used up.'
        While inVal <> ""
            Range(fromCol + fromRow).Select

            ' Extract each subentry.'
            commaPos = InStr(1, inVal, ",")
            While commaPos <> 0

                ' and write to output column.'
                outVal = Left(inVal, commaPos - 1)
                Range(toCol + toRow).Select
                Range(toCol + toRow).Value = outVal
                toRow = Mid(Str(Val(toRow) + 1), 2)

                ' Remove that sub-entry.'
                inVal = Mid(inVal, commaPos + 1)
                While Left(inVal, 1) = " "
                    inVal = Mid(inVal, 2)
                Wend
                commaPos = InStr(1, inVal, ",")
            Wend

            ' Get last sub-entry (or full entry if no commas).'
            Range(toCol + toRow).Select
            Range(toCol + toRow).Value = inVal
            toRow = Mid(Str(Val(toRow) + 1), 2)
            inVal = ""
        Wend

        ' Advance to next source row.'
        fromRow = Mid(Str(Val(fromRow) + 1), 2)
        Range(fromCol + fromRow).Select
        inVal = Range(fromCol + fromRow).Value
    Wend
End Sub
 B Z23 янв. 2009 г., 16:22
отлично работает, спасибо

но это сработало (как-то !!)

Sub arrange()

' get the current range from the sheet
    curr_range = ActiveSheet.Range("A1:A6")

' for each cell in that range ...
    For Each Row In curr_range

' ...put the contents into an array
        arr = Split(Row, ",")

' for each cell in that array ...
        For Each cell In arr

' ...output it into a string
            output_str = output_str & "," & cell
        Next cell

    Next Row

' remove spaces
    output_str = Replace(output_str, " ", "")
' remove left ,
    output_str = Right(output_str, Len(output_str) - 1)

' make it into an array
    output_arr = Split(output_str, ",")

' populate the sheet back
    ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr)

End Sub
 paxdiablo23 янв. 2009 г., 05:14
Когда я запускаю это, я получаю много # N / A ячеек под правильными ячейками.
 paxdiablo23 янв. 2009 г., 04:36
Я ненавижу то, что SO делает с комментариями VBA - я обнаружил, что вам нужно поставить «» в конце строки, чтобы убедиться, что раскраска работает правильно.
 paxdiablo23 янв. 2009 г., 05:22
Небольшие критические замечания (не стоит понижать голосование): 1 / Вы удаляете все пробелы в поле (например, «Боб, Джилл Смит, Джордж» становится «Боб», «Джиллсмит», «Джордж»). 2 / Ваше "удалить слева" лучше, чем "output_str = mid (output_str, 2)". Кроме этого и АН, кажется, все в порядке.

Ваш ответ на вопрос