VBAコードリストボックスで選択された項目に基づいて列を動的に並べ替える

Question

VBAで非常に新しいです、私の質問は リストボックスのユーザーの選択に基づいて列を並べ替える方法は？またはこれを行う他のuserformsがありますか？

8つの文字列と12ヶ月のコラム（合計20件のcols）

は、私はその後、A列に基づいてこれを小計、12ヶ月の列と一緒にlistbox1をから選択された列を取得する準備listbox1をしましたがありますリストボックス1のインデックス番号に基づいて列に値を設定するコード

しかし、実際には、リストボックス1で選択したユーザーに基づいて並べ替える必要があります。

と仮定 - ユーザが第2の最初の4列目と1列目を選択した場合、私は列が配置されるべき同様の方法を必要とする -

すべてのヘルプは本当に、完成したプロジェクトに私を悩まだけこの部分を理解されるであろう。 助けてくれてありがとう！

---

Private Sub CommandButton1_Click() 

'Variable Declaration 

Dim iCnt As Integer, i As Long, j As Long, shdr As String 

Dim MyHdr() As String, cols(12) As Long 

Dim count As Integer, lastRow As Integer, destCol As Integer 
count = 0 

destCol = 1 
For iCnt = 0 To Me.ListBox1.ListCount - 1 

If Me.ListBox1.Selected(iCnt) = True Then 

ReDim Preserve MyHdr(count) 

MyHdr(count) = ListBox1.List(iCnt) 

count = count + 1 

End If 

Next iCnt 
If count = 0 Then 

MsgBox "Please Select One Or More Items Then Try Again!", vbExclamation 

Exit Sub 

End If 
Application.ScreenUpdating = False 

With Sheet2.Range("A16:Z10000") 

On Error Resume Next 

.RemoveSubtotal 

On Error GoTo ErrHandler 
.ColumnWidth = 9 

.Clear 

End With 
'Find Last Row In Sheet1 

lastRow = Sheet1.Cells.SpecialCells(xlLastCell).Row 
For i = LBound(MyHdr) To UBound(MyHdr) 

shdr = MyHdr(i) 

For j = 1 To 8 

If Sheet1.Cells(1, j) = shdr Then 

Sheet1.Range(Sheet1.Cells(1, j), Sheet1.Cells(lastRow, j)).Copy Destination:=Sheet2.Cells(16, destCol) 

destCol = destCol + 1 

Exit For 

End If 

Next j 

Next i 
'Copy Month Data 

Sheet1.Range(Sheet1.Cells(1, 9), Sheet1.Cells(lastRow, 20)).Copy Destination:=Sheet2.Cells(16, destCol) 
Sheet2.Range("A16:T100000").Sort _ 
Key1:=Range("A1"), Header:=xlYes 
Columns("A").ColumnWidth = 25 

'Add Column Totals 

destCol = destCol + 12 
With Sheet2 

.Cells(16, destCol).Value = "Grand Total" 

.Cells(16, destCol).ColumnWidth = 13 

.Range("A16").Copy 

.Cells(16, destCol).PasteSpecial Paste:=xlPasteFormats 
.Range(.Cells(1, 1), .Cells(1, destCol - 1)).ColumnWidth = 11 

.Range(.Cells(17, destCol), .Cells(lastRow + 15, destCol)).FormulaR1C1 = "=SUM(RC2:RC[-1])" 
'Add Subtotals 

For i = 0 To 12 

cols(i) = destCol - 12 + i 

Next i 
.Cells(16, 1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=cols, Replace:=True, PageBreaks:=False, SummaryBelowData:=True 
.Outline.ShowLevels RowLevels:=2 

Sheet1.Activate: .Activate 

End With 
ExitHandler: 

Unload Me 

Application.CutCopyMode = False 

Application.ScreenUpdating = True 
Exit Sub 
ErrHandler: 

MsgBox Err.Description, vbExclamation 

Resume ExitHandler 

End Sub 

---

を上記のコードがうまく機能しているが、私はテキスト列は、ユーザが選択されている方法を並べ替える取得することができcouldntは - ラグー

以下

は、現在使用していたコードですリストボックス1では、最初に貼り付ける列ヘッダーのユーザーが選択してから、選択したパターンに従うようにします。

例：テーブルが開始される - Col（5,1,3）またはCol（8,5,2,6,1,7,3,4）のいずれかの順序で、列が貼り付けられる順序と同じ順序で選択されます。

Answer 1

宣言MyHdr()とcount()ユーザーフォームは、変数をスコープ、そしてあなたのCommandButton1_Click()の最初の部分になるように

Option Explicit 

Dim MyHdr() As String '<--| place it at the very top of your userform code pane to become userform scoped variable 
Dim count As Integer '<--| place it at the very top of your userform code pane to become userform scoped variable 

Private Sub ListBox1_Change() 
    Dim iCnt As Integer, iArr As Integer 

    With Me.ListBox1 
     If .Selected(.ListIndex) Then '<--| if item selected then add it to 'Hydr()' 
      count = count + 1 '<--| update counter 
      ReDim Preserve MyHdr(count - 1) 
      MyHdr(count - 1) = .List(.ListIndex) 
     Else '<--| if item selected then remove it to 'Hydr()' 
      For iCnt = 0 To UBound(MyHdr) '<--| loop through 'Hydr()' and find its position 
       If MyHdr(iCnt) = .List(.ListIndex) Then '<--| once found 
        For iArr = iCnt + 1 To UBound(MyHdr) '<-- swap back 'Hydr()' elements and erase the deselected one 
         MyHdr(iArr - 1) = MyHdr(iArr) 
        Next 
        Exit For 
       End If 
      Next iCnt 
      count = count - 1 '<--| update counter 
      If count > 0 Then ReDim Preserve MyHdr(count - 1) '<--| resize 'Hydr()' 
     End If 
    End With 
End Sub 

を次のようにListBox1_Change()イベントハンドラは、彼らに

を更新してきたように：

Private Sub CommandButton1_Click() 
    Dim Sheet1 As Worksheet, Sheet2 As Worksheet 

    'Variable Declaration 

    Dim iCnt As Integer, i As Long, j As Long, shdr As String 
    Dim cols(12) As Long 
    Dim count As Integer, lastRow As Integer, destCol As Integer 

    count = 0 

    If count = 0 Then 
     MsgBox "Please Select One Or More Items Then Try Again!", vbExclamation 
     Exit Sub 
    End If 
    destCol = 1  

    Application.ScreenUpdating = False 

    ' here follows the rest of your sub