Excel-Изменить данные таблицы для нормализации данных

Question

Я хочу создать какое-то веб-приложение, используя базовые данные из Excel, но структуру данных необходимо настроить

Может кто-нибудь помочь мне изменить эту таблицу
ABCD
EFGH
IJKL
MNOP

до

AB
AC
AD
EF
EG
EH
IJ
IK
IL
MN
MO
MP

или что-то в этом роде, я уже пробовал использовать этот макрос

http://www.get -digital-help.com / 2012/05/07 / vba-macro-normalize-data /

работает на сотнях данных, но когда я пытаюсь использоватьон> 12000 данных перестает работать

Answer 1

Проблема с макросом, на который вы указали, заключается в строках

Rng.Offset(r, 0).Value

По крайней мере для меня, когда я удаляю ссылку на диапазон и заменяю ее ссылкой на первую ячейку, например, такую ​​как

WS1.Range("A1").Offset(r, 0).Value

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

Полный макрос с изменением:

Sub NormalizeData()
Dim Rng As Range
Dim WS As Worksheet

Application.Calculation = xlCalculationManual
On Error Resume Next
Set Rng = Application.InputBox(Prompt:="Select a range to normalize data" _
, Title:="Select a range", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0

If Rng Is Nothing Then
Else
    Application.ScreenUpdating = False
    Set WS1 = ActiveSheet                       '<==== added this line
    Set WS = Sheets.Add
    i = 0
    For r = 0 To Rng.Rows.Count - 1             '<==== offset start changed to 0
        For c = 1 To Rng.Columns.Count - 1
            WS.Range("A1").Offset(i, 0) = WS1.Range("A1").Offset(r, 0).Value '<==== change
            WS.Range("A1").Offset(i, 1) = WS1.Range("A1").Offset(r, c).Value '<==== change
            i = i + 1
        Next c
        Application.StatusBar = r
    Next r
    WS.Range("A:C").EntireColumn.AutoFit
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End If
End Sub

Answer 2

Попробуйте это:

'select a cell in your data before running
Sub DoIt()

    Dim data, n As Long, r As Long, c As Long
    Dim result(), i As Long

    With Selection.CurrentRegion
        data = .Value
        n = .Cells.Count
    End With

    ReDim result(1 To n, 1 To 2)
    i = 0

    For r = 1 To UBound(data, 1)
        For c = 2 To UBound(data, 2)
            If Len(data(r, c)) > 0 Then
                i = i + 1
                result(i, 1) = data(r, 1)
                result(i, 2) = data(r, c)
            End If
        Next c
    Next r

    'adjust output location to suit
    ActiveSheet.Range("G1").Resize(i, 2) = result

End Sub

Вход / выход: