将 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

这将创建一个名为“For 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 & ")"

使用示例数据的结果