简体   繁体   中英

Can You Turn Unstructured References to Structured Using VBA? (Excel 2010)

I have an excel table (an actual table ie Insert > Table) that uses structured references in all of the formulas. Example: =[@[Predicted Total 2015 Days]]-COUNTA(All.Departments[@[1]:[40]])

The problem I'm having is I want to sort several of the columns from Left to Right. Excel doesn't let you do this with tables, only ranges (at least from what I've found on the subject) So it seems that my only option is to unlist the table (convert it to a range) and then convert it back. However after converting it back to a table my formulas lose their structured references Example : =Sheet2!$V2-COUNTA(Sheet2!$X2:$BK2)

Is there any way to convert these formulas back to structured? Or even better yet, a way to sort left to right without having to convert my table back and forth?

I was able to sort columns using the structured references in Excel 2010 with no issues. Formulas within the table using structured references to other columns and data were sorted. No converting formulas back and forth.

Option Explicit

Sub SortTable()
    Dim ws As Worksheet
    Dim tbl As ListObject

    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("MyTable")

    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range(tbl.Name & "[PredictedTotal]"), _
                        SortOn:=xlSortOnValues, Order:=xlDescending, _
                        DataOption:=xlSortNormal
        .SortFields.Add Key:=ws.Range(tbl.Name & "[AllDepartments]"), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, _
                        DataOption:=xlSortNormal
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

I figured out a way around converting my table to a range. In case anyone was curious I decided to post my solution.

It's now set up to copy the entire table, Paste it as transposed values into a destination worksheet, where it then does a loop sorting each column's dates from oldest to newest, and then it takes those sorted dates and pastes them as transposed values back into the original table.

Yay to figuring out my own solution! =D

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Application.ScreenUpdating = False

Dim SourceWS As Worksheet
Dim DestWS As Worksheet
Dim TblRange As Range
Dim DataRange As Range
Dim LastRow As Long

Set SourceWS = Worksheets("For HR Use ONLY")
Set DestWS = Worksheets("Transposed Table")

DestWS.Visible = xlSheetVisible
DestWS.Cells.ClearContents

SourceWS.Activate

LastRow = SourceWS.Range("A1").CurrentRegion.Rows.Count
Set TblRange = SourceWS.Range("A1:BM" & LastRow)

TblRange.Copy
DestWS.Range("A1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, True, True
Application.CutCopyMode = False

Set DataRange = SourceWS.Range("O2:BB" & LastRow)
DataRange.ClearContents

DestWS.Activate
Dim x As Long, LastCol As Long
LastCol = SourceWS.Range("A1").CurrentRegion.Rows.Count
For x = 2 To LastCol
Range(Cells(15, x), Cells(54, x)).Sort Key1:=Cells(15, x), Order1:=xlAscending, Header:=xlGuess
Next x

DestWS.Range(Cells(15, 2), Cells(54, LastCol)).Copy

SourceWS.Range("O2").PasteSpecial xlPasteValues, lPasteSpecialOperationNone, True, True
Application.CutCopyMode = False

DestWS.Visible = xlSheetHidden

SourceWS.Activate
SourceWS.Range("A1").Select

Set SourceWS = Nothing
Set DestWS = Nothing
Set TblRange = Nothing
Set DataRange = Nothing

Application.ScreenUpdating = True

End Sub

I was confronted by the same problem. Use the following recipe:

  1. CTRL+A // Select entire table.
  2. CTRL+H // Replace all equal signs with | or character of your choice.
  3. ALT+J+G // Convert to range.
  4. ALT+H+S+U+O+L // Special Sort from left-to-right. Choose sorting row.
  5. CTRL+T // Convert back to Table. Remember to rename it!
  6. CTRL+H // Put back all your equal signs.

You're done. Caveat: if you have any array formulas, you'll have to recommit them with CTRL+SHIFT+ENTER

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM