Excel公式/VBA以对表格进行排序

huangapple
go评论103阅读模式
英文:

Excel formula/VBA to sort table

问题

如何对表格进行排序？我有一个数据集（列 A - G），我想按照上述顺序仅显示列 A、C、E、B。是否有可以用来自动化的 Excel 公式 / VBA 公式？

英文:

How to sort a table? I have a dataset (column A - G) that I would like to sort to show only columns A, C, E, B in the above order. Is there an excel formula / VBA formula that I can look into to automate?

答案1

得分: 1

选择列

Excel公式/VBA以对表格进行排序

Excel公式

Microsoft 365 2022

  1. =CHOOSECOLS(A1:G11,1,3,5,2)

或者使用包含行分隔符的数组

  1. =CHOOSECOLS(A1:G11,{1;3;5;2})

或者使用正确的列分隔符的数组
或者前两者的组合。

Microsoft 365 2021

  1. =LET(d,A1:G11,c,{1,3,5,2},
  2.     r,SEQUENCE(ROWS(d)),
  3. INDEX(d,r,c))

  • 根据您的小数分隔符，数组中的列分隔符（数组{1,3,5,2}中的逗号）可能不同。
    到目前为止，我遇到了{1.3.5.2}、{1\3\5\2}或{1@3@5@2}。

  • 为了使其适用于任何区域设置，您可以使用TRANSPOSE（还没有TOROW）与行分隔符：

  1. =LET(d,A1:G11,rc,{1;3;5;2},
  2.     r,SEQUENCE(ROWS(d)),c,TRANSPOSE(rc),
  3. INDEX(d,r,c))

旧版本

  1. =INDEX(A1:G11,ROW(A1:G11)-ROW(A1)+1,{1,3,5,2})

如果您的数据从第1行开始，可以简化为：

  1. =INDEX(A1:G11,ROW(A1:G11),{1,3,5,2})
  • 与2021版本一样，您可以通过使用TRANSPOSE({1;3;5;2})来使两者都适用于任何区域设置。

VBA

包括公式和格式在内复制

  1. Sub CopyColumns()
  3.     Dim Cols(): Cols = Array(1, 3, 5, 2)
  5.     Dim wb As Workbook: Set wb = ThisWorkbook ' 包含此代码的工作簿
  6.     Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
  7.     
  8.     Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
  9.     
  10.     Dim dfCell As Range: Set dfCell = ws.Range("I1")
  11.     
  12.     Dim Col
  13.     
  14.     For Each Col In Cols
  15.         Debug.Print "复制" & Chr(34) & srg.Columns(Col).Address(0, 0) _
  16.             & Chr(34) & "到" & Chr(34) & dfCell.Address(0, 0) & Chr(34) & "..."
  17.         srg.Columns(Col).Copy dfCell
  18.         Set dfCell = dfCell.Offset(, 1)
  19.     Next Col
  20.  
  21.     MsgBox "列已复制。", vbInformation
  23. End Sub

仅复制值（使用函数）

函数

  1. Function ChooseColumns( _
  2.     ByVal SourceRange As Range, _
  3.     ByVal ChosenColumns As Variant) _
  4. As Variant
  5.     
  6.     Dim rCount As Long: rCount = SourceRange.Rows.Count
  7.     Dim scCount As Long: scCount = SourceRange.Columns.Count
  8.     
  9.     Dim sData()
  10.     
  11.     If rCount * scCount = 1 Then
  12.         ReDim sData(1 To 1, 1 To 1): sData(1, 1) = SourceRange.Value
  13.     Else
  14.         sData = SourceRange.Value
  15.     End If
  16.         
  17.     Dim dcCount As Long:
  18.     dcCount = UBound(ChosenColumns) - LBound(ChosenColumns) + 1
  19.     
  20.     Dim dData(): ReDim dData(1 To rCount, 1 To dcCount)
  21.         
  22.     Dim sCol, r As Long, dc As Long
  23.     
  24.     For Each sCol In ChosenColumns
  25.         dc = dc + 1
  26.         For r = 1 To rCount
  27.             dData(r, dc) = sData(r, sCol)
  28.         Next r
  29.     Next sCol
  31.     ChooseColumns = dData
  33. End Function

子程序（使用函数）

  1. Sub CopyColumnsUsingFunction()
  3.     Dim Cols(): Cols = Array(1, 3, 5, 2)
  5.     Dim wb As Workbook: Set wb = ThisWorkbook ' 包含此代码的工作簿
  6.     Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
  7.     
  8.     Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
  9.     
  10.     Dim Data(): Data = ChooseColumns(srg, Cols)
  11.     
  12.     Dim dfCell As Range: Set dfCell = ws.Range("I1")
  13.     
  14.     dfCell.Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
  15.     
  16.     MsgBox "列已复制。", vbInformation
  18. End Sub

列表分隔符

  1. Sub ShowMySeparators()
  2.     With Application
  3.         Debug.Print "备用: " & .International(xlAlternateArraySeparator)
  4.         Debug.Print "列: " & .International(xlColumnSeparator)
  5.         Debug.Print "小数: " & .International(xlDecimalSeparator)
  6.         Debug.Print "列表: " & .International(xlListSeparator)
  7.         Debug.Print "行: " & .International(xlRowSeparator)
  8.         Debug.Print "千位分隔符: " & .International(xlThousandsSeparator)
  9.     End With
  10. End Sub

我的系统上的结果

  1. 备用: @
  2. 列: ,
  3. 小数: .
  4. 列表: ;
  5. 行: ;
  6. 千位分隔符: ,
英文:

Choose Columns

Excel公式/VBA以对表格进行排序

Excel Formula

Microsoft 365 2022

  1. =CHOOSECOLS(A1:G11,1,3,5,2)

or by using an array with row separators

  1. =CHOOSECOLS(A1:G11,{1;3;5;2})

or using the array with the correct column separators
or a combination of the previous two.

Microsoft 365 2021

  1. =LET(d,A1:G11,c,{1,3,5,2},
  2.     r,SEQUENCE(ROWS(d)),
  3. INDEX(d,r,c))

  • Depending on your decimal separator, the array column separator (the comma(s) in the array {1,3,5,2}) may be different.
    So far, I have encountered {1.3.5.2}, {1\3\5\2}, or {1@3@5@2}.

  • To make it work on any locale, you could use TRANSPOSE (there is no TOROW yet) with row separators:

  1. =LET(d,A1:G11,rc,{1;3;5;2},
  2.     r,SEQUENCE(ROWS(d)),c,TRANSPOSE(rc),
  3. INDEX(d,r,c))

Older Versions

  1. =INDEX(A1:G11,ROW(A1:G11)-ROW(A1)+1,{1,3,5,2})

If your data starts in row 1, you can simplify with:

  1. =INDEX(A1:G11,ROW(A1:G11),{1,3,5,2})
  • The same as in 2021, you can make both work for any locale by using TRANSPOSE({1;3;5;2}).

VBA

Copy Including Formulas and Formatting

  1. Sub CopyColumns()
  3.     Dim Cols(): Cols = Array(1, 3, 5, 2)
  5.     Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
  6.     Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
  7.     
  8.     Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
  9.     
  10.     Dim dfCell As Range: Set dfCell = ws.Range("I1")
  11.     
  12.     Dim Col
  13.     
  14.     For Each Col In Cols
  15.         Debug.Print "Copying """ & srg.Columns(Col).Address(0, 0) _
  16.             & """ to """ & dfCell.Address(0, 0) & """..."
  17.         srg.Columns(Col).Copy dfCell
  18.         Set dfCell = dfCell.Offset(, 1)
  19.     Next Col
  20.  
  21.     MsgBox "Columns copied.", vbInformation
  23. End Sub

Copy Values Only (Using a Function)

The Function

  1. Function ChooseColumns( _
  2.     ByVal SourceRange As Range, _
  3.     ByVal ChosenColumns As Variant) _
  4. As Variant
  5.     
  6.     Dim rCount As Long: rCount = SourceRange.Rows.Count
  7.     Dim scCount As Long: scCount = SourceRange.Columns.Count
  8.     
  9.     Dim sData()
  10.     
  11.     If rCount * scCount = 1 Then
  12.         ReDim sData(1 To 1, 1 To 1): sData(1, 1) = SourceRange.Value
  13.     Else
  14.         sData = SourceRange.Value
  15.     End If
  16.         
  17.     Dim dcCount As Long:
  18.     dcCount = UBound(ChosenColumns) - LBound(ChosenColumns) + 1
  19.     
  20.     Dim dData(): ReDim dData(1 To rCount, 1 To dcCount)
  21.         
  22.     Dim sCol, r As Long, dc As Long
  23.     
  24.     For Each sCol In ChosenColumns
  25.         dc = dc + 1
  26.         For r = 1 To rCount
  27.             dData(r, dc) = sData(r, sCol)
  28.         Next r
  29.     Next sCol
  31.     ChooseColumns = dData
  33. End Function

The Sub (Using the Function)

  1. Sub CopyColumnsUsingFunction()
  3.     Dim Cols(): Cols = Array(1, 3, 5, 2)
  5.     Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
  6.     Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
  7.     
  8.     Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
  9.     
  10.     Dim Data(): Data = ChooseColumns(srg, Cols)
  11.     
  12.     Dim dfCell As Range: Set dfCell = ws.Range("I1")
  13.     
  14.     dfCell.Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
  15.     
  16.     MsgBox "Columns copied.", vbInformation
  18. End Sub

List Separators

  1. Sub ShowMySeparators()
  2.     With Application
  3.         Debug.Print "Alternate: " & .International(xlAlternateArraySeparator)
  4.         Debug.Print "Column: " & .International(xlColumnSeparator)
  5.         Debug.Print "Decimal: " & .International(xlDecimalSeparator)
  6.         Debug.Print "List: " & .International(xlListSeparator)
  7.         Debug.Print "Row: " & .International(xlRowSeparator)
  8.         Debug.Print "Thousands: " & .International(xlThousandsSeparator)
  9.     End With
  10. End Sub

Results on My System

  1. Alternate: @
  2. Column: ,
  3. Decimal: .
  4. List: ;
  5. Row: ;
  6. Thousands: ,

huangapple
  • 本文由 发表于 2023年6月16日 07:14:43
  • 转载请务必保留本文链接：https://go.coder-hub.com/76486043.html
  • excel
  • excel-formula
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定