对VBA来说很新，我的问题是 - 如何根据用户在列表框中的选择重新排序列？或者还有其他用户形式吗？
有8个文本列和12个月列（共20个列）
我有一个listbox1准备获取从listbox1中选择的列以及12个月的列，然后根据列A进行小计。此代码根据listbox1索引号填充列，
但我真的需要根据listbox1中选择的用户重新排列列。
假设 - 如果用户选择第一列第一列，第一列第二列，我需要以相似的方式排列列 -
任何帮助都会非常感激，只有这部分让我很难完成这个项目。 谢谢您的帮助！！ Raghu
下面是我目前正在使用的代码 -
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
上面的代码运行良好，但我无法按照用户在listbox1中选择的方式重新排序文本列，无论哪个列标题用户选择该列应先粘贴然后继续按照所选模式直到用户选择完成后，
例如：表格可以开始 - Col（5,1,3）或Col（8,5,2,6,1,7,3,4），无论选择哪个顺序，列都应粘贴。< / p>
答案 0 :(得分：0)
将function countWords() {
var collectedText;
$('p,h1,h2,h3,h4,h5').each(function(index, element){
collectedText += element.innerText + " ";
});
// Remove 'undefined if there'
collectedText = collectedText.replace('undefined', '');
// Remove numbers, they're not words
collectedText = collectedText.replace(/[0-9]/g, '');
// Get
console.log("You have " + collectedText.split(' ').length + " in your document.");
return collectedText;
}
和MyHdr()声明为userform作用域变量，然后让count()事件处理程序更新它们
如下
ListBox1_Change()以便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
的第一部分成为：
CommandButton1_Click()