Переместить каждую ячейку после столбца A на новой строке

Question

Я хотел бы экспортировать некоторые данные в MySQL, однако до этого я хотел бы отформатировать данные. Я не уверен, как это объяснить, поэтому я сделал несколько скриншотов.

Как я мог превратить это:

В это?

1   23
1   5
1   20
2   3
2   5
3   67
3   24
3   653
3   43

Количество столбцов справа после Column B может быть бесконечным. Но мне нужно поместить все вещи в Columns C,D,E...etc На новую строку в Column B

Спасибо

Answer 1

Это создаст новый лист с именем "Для MySQL" и поместит результат там:

Option Explicit
Public Sub rowToCol()
    Const FC As Long = 1    'first col (ID)
    Const FR As Long = 2    'first row
    Const NEXT_COL As Long = FC + 1
    Const DB_WS_NAME As String = "For MySQL"

    Dim ws As Worksheet, db As Worksheet, lr As Long, lc As Long, maxRow As Long
    Dim arr1 As Variant, arr2 As Variant, i As Long, j As Long, k As Long

    Set ws = Worksheets("Sheet1")   'main sheet -----------------------------------------
    lr = ws.Cells(ws.UsedRange.Rows.Count + 1, FC).End(xlUp).Row
    lc = ws.UsedRange.Columns.Count
    If lr >= FR Then
        maxRow = (lr - (FR - 1)) * (lc - FC) + FR   'set result area
        Application.ScreenUpdating = False: Application.DisplayAlerts = False
        For Each db In Worksheets
            If db.Name = DB_WS_NAME Then
                db.Delete: Exit For
            End If
        Next
        Set db = Worksheets.Add(After:=ws): db.Name = DB_WS_NAME
        arr1 = ws.Range(ws.Cells(FR, FC), ws.Cells(lr, lc)).Value2
        arr2 = db.Range(db.Cells(FR, FC), db.Cells(maxRow, NEXT_COL)).Value2
        k = FR - 1
        For i = FR - 1 To lr - (FR - 1) 'all rows
            For j = NEXT_COL To lc      'all cols
                If Len(arr1(i, j)) = 0 Then Exit For  'exit inner For (this row is done)
                arr2(k, FC) = arr1(i, FC)
                arr2(k, NEXT_COL) = arr1(i, j)
                k = k + 1
            Next
        Next
        db.Range(db.Cells(FR, FC), db.Cells(maxRow, NEXT_COL)).Value2 = arr2
        Application.DisplayAlerts = True: Application.ScreenUpdating = True
    End If
End Sub

Результат:

Answer 2

Вот небольшой макрос для прямого экспорта ваших данных в текстовый файл без необходимости дополнительного листа

• Измените "D:\sql_import.txt" на желаемый путь вывода
• Измените [B2:E4] на желаемый диапазон ввода Excel

Код VBA

Sub ExportForSql()
    Open "D:\sql_import.txt" For Output As #1
    For Each cell In [B2:E4]
        If Not cell.Value = vbNullString Then
            Print #1, Cells(cell.Row, 1) & vbTab & cell.Value
        End If
    Next cell
    Close #1
End Sub

Или вы экспортируете его сразу с правильным синтаксисом SQL, используя что-то похожее на это

Print #1, "INSERT INTO " & Cells(cell.Row, 1) & " VALUES (" & cell.Value & ")"

Результаты с данными вашего примера