2

У меня есть лист Excel, как

A 1234
  1234
  1234 
  1234
B 12
  12

и так далее

Мне нужно получить лист как

A 1234 1234 1234 1234
B 12 12

1 ответ1

1

Вот макрос VBA, чтобы изменить ваши данные, как указано

Он обрабатывает активный лист и предполагает: 1) данные начинаются в ячейке A1, 2) в строках или столбцах нет пропусков, 3) нет других данных на листе, 4) данные состоят из значений (не формул), 5) форматирование не нужно сохранять.

Sub OneColumn()
    Dim rng As Range
    Dim vSrc As Variant
    Dim vDst As Variant
    Dim cl As Range
    Dim ws As Worksheet
    Dim rwSrc As Long, rwDst As Long
    Dim i As Long

    Set ws = ActiveSheet
    ' find the right most used column
    Set cl = ws.UsedRange.Find("*", [A1], xlValues, , xlByColumns, xlPrevious)

    ' in case there is no data on the sheet    
    If Not cl Is Nothing Then
        ' get a range bounding the data
        Set rng = Range(ws.[A1], ws.[A1].End(xlDown).Offset(, cl.Column - 1))

        ' copy source data to an array
        vSrc = rng

        ' size another array large enough (too large) to hold destination data  
        '   (note: vDst is transposed to allow for later redim preserve)
        ReDim vDst(1 To 2, 1 To UBound(vSrc, 1) * (UBound(vSrc, 2) - 1))

        ' loop through the source data, copying to the destination array
        rwDst = 1
        For rwSrc = 1 To UBound(vSrc, 1)
            vDst(1, rwDst) = vSrc(rwSrc, 1)
            For i = 2 To UBound(vSrc, 2)
                If vSrc(rwSrc, i) <> "" Then
                    vDst(2, rwDst + i - 2) = vSrc(rwSrc, i)
                Else
                    Exit For
                End If
            Next
            rwDst = rwDst + i - 2
        Next

        ' discard excess size from destination array
        ReDim Preserve vDst(1 To 2, 1 To rwDst)

        ' clear old data from sheet
        rng.Clear
        ' put result on sheet
        [A1].Resize(UBound(vDst, 2), 2) = Application.Transpose(vDst)
    End If
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .