Question

我正在处理的当前代码要求我重新排列VBA中的列。它必须根据标题排列，标题是＆＃34; Vd（1）＆＃34;，＆＃34; Vg（1）＆＃34;，＆＃34; Id（1）＆＃34;，＆＃34; Ig（1）＆＃34; ，此组重复数字2,3等等（例如 Vd（2），Ig（4）< /强>）。这些数据通常是混乱的，我必须按升序排列。

V-g，V-d，I-d或I-g首先出现并不重要。

Dim num, numadj As Integer Dim colu, coladj Range("A1").Select Do While Range("A1").Offset(0, i - 1).Value <> "" colu = ActiveCell.Value coladj = ActiveCell.Offset(0, 1).Value num = Left(Right(colu.Text, 2), 1) numadj = Left(Right(coladj.Text, 2), 1) If num > numadj Then colu.EntireColumn.Cut Destination:=Columns("Z:Z") coladj.EntireColumn.Cut Destination:=colu Columns("Z:Z").Select.Cut Destination:=coladj i = i + 1 Else i = i + 1 End If Loop

我对VBA很新，所以请原谅我创建的任何哑码！提前谢谢大家！

Answer 1

考虑使用SQL和RegEx解决方案来选择指定排列中的列。 SQL适用于Excel for PC，可以访问Windows的Jet / ACE SQL Engine来查询自己的工作簿，就像数据库表一样。

由于3-10范围内集的变量性质，请考虑使用定义函数FindHighestNumberSet通过RegEx从列标题中提取数字来查找设置的最大数字。然后让RunSQL子例程调用函数来动态构建SQL字符串。

下面假设您的数据当前位于名为 DATA 的选项卡中，并带有一个名为 RESULTS 的空选项卡，它将输出查询结果。有两个ADO连接字符串可用。

功能 （跨列标题迭代以提取最高数字）

Function FindHighestNumberSet() As Integer
    Dim lastcol As Integer, i As Integer
    Dim num As Integer: num = 0
    Dim regEx As Object

    ' CONFIGURE REGEX OBJECT
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
       .Global = True
       .MultiLine = True
       .IgnoreCase = False
       .Pattern = "[^0-9]"
    End With

    With Worksheets("DATA")
       lastcol = .Cells(7, .Columns.Count).End(xlToLeft).Column

       For i = 1 To lastcol
         ' EXTRACT NUMBERS FROM COLUMN HEADERS
         num = Application.WorksheetFunction.Max(num, CInt(regEx.Replace(.Cells(1, i), "")))
       Next i

    End With

    FindHighestNumberSet = num
End Function

宏 （主模块循环上述功能的结果）

Sub RunSQL()
On Error GoTo ErrHandle
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' DRIVER AND PROVIDER CONNECTION STRINGS
'    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
'                      & "DBQ=" & Activeworkbook.FullName & ";"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='" & ActiveWorkbook.FullName & "';" _
                       & "Extended Properties=""Excel 8.0;HDR=YES;"";"

    ' FIRST THREE SETS
    strSQL = " SELECT t.[V-d(1)], t.[I-d(1)], t.[I-g(1)]," _
                  & " t.[V-d(2)], t.[I-d(2)], t.[I-g(2)]," _
                  & " t.[V-d(3)], t.[I-d(3)], t.[I-g(3)]"

    ' VARIABLE 4+ SETS
    For i = 4 To FindHighestNumberSet
        strSQL = strSQL & ", t.[V-d(" & i & ")], t.[I-d(" & i & ")], t.[I-g(" & i & ")]"
    Next i

    ' FROM CLAUSE
    strSQL = strSQL & " FROM [DATA$] t"

    ' OPEN DB CONNECTION
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS
    For i = 1 To rst.Fields.Count
        Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
    Next i

    ' DATA ROWS
    Worksheets("RESULTS").Range("A2").CopyFromRecordset rst

    rst.Close: conn.Close
    Set rst = Nothing: Set conn = Nothing

    MsgBox "Successfully ran SQL query!", vbInformation
    Exit Sub

ErrHandle:
    Set rst = Nothing: Set conn = Nothing
    MsgBox Err.Number & " = " & Err.Description, vbCritical
    Exit Sub
End Sub

Answer 2

您可以使用类似这样的（测试的）辅助行垂直排序：

Sub test() ': Cells.Delete: [b2:d8] = Split("V-d(10) V-d(2) V-d(1)") ' used for testing
    Dim r As Range: Set r = ThisWorkbook.Worksheets("Sheet1").UsedRange  ' specify the range to be sorted here

    r.Rows(2).Insert xlShiftDown ' insert helper row to sort by. (used 2nd row instead 1st so that it is auto included in the range)
    r.Rows(2).FormulaR1C1 = "=-RIGHT(R[-1]C,LEN(R[-1]C)-3)" ' to get the numbers from the column header cells above, so adjust if needed

    r.Sort r.Rows(2) ' sort vertically by the helper row
    r.Rows(2).Delete xlShiftUp ' delete the temp row
End Sub

重新排列VBA中的列

2 个答案: