Przenieś każdą komórkę po kolumnie A w nowej linii

1

Chciałbym wyeksportować niektóre dane do MySQL, jednak wcześniej chciałbym je sformatować. Nie wiem, jak to wyjaśnić, więc zrobiłem kilka zrzutów ekranu.

Jak mogę to odwrócić:

Zaangażowany w to?

Ilość kolumn po prawej stronie Column B może być nieskończona. Ale muszę włożyć wszystkie rzeczy Columns C,D,E...etc w nowej linii Column B.

Dzięki

microsoft-excel vba microsoft-excel-2013

— pufAmuf
źródło

1

Spowoduje to utworzenie nowego arkusza o nazwie „Dla MySQL” i umieszczenie tam wyniku:

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

Wynik:

— paul bica
źródło

Wow, jesteś szefem. Po przeczytaniu pytania pomyślałem, że nikt nie będzie w stanie tego zrobić, szkoda, że nie mogę dać ci więcej niż 1 głos.

— pufAmuf

Cieszę się, że to pomogło. Inną opcją (VBA) byłoby przetransponowanie każdego wiersza, wypełnienie pierwszej kolumny id i usunięcie pierwszego wiersza, przejście do następnego wiersza umieszczenie go i powtórzenie tego procesu, ale jeśli masz dużo danych (wierszy) to byłoby wolniejsze niż odpowiedź

— paul bica

1

Oto małe makro, które bezpośrednio eksportuje dane do pliku tekstowego bez potrzeby dodatkowego arkusza

Zmiana "D:\sql_import.txt" do żądanej ścieżki wyjściowej
Zmiana [B2:E4] do żądanego zakresu wejściowego Excel

Kod 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

Możesz też wyeksportować go od razu przy użyciu poprawnej składni SQL, używając czegoś podobnego do tego

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

Wyniki z przykładowymi danymi

— nixda
źródło