使用VBA在Excel中sorting和聚合单元格数据时遇到困难
我已经更新了这个
更新亮点
- 更改了代码的一部分，以删除生成的Sheet8.L5字段中不必要的逗号。
- 还实施了feelththisbuild议的build议。
- 现在它只返回“1,9”，而不是所需的“1,9,29,37,50,61”
原文（稍有改动）
我试图从三张表格中获取细胞数据，每张表格有五个细胞，共计十五个细胞。 删除所有的零值。 数字命令剩下的。 将其插入到另一个逗号分隔的单个单元格中。 所有的细胞数据应该只包含正数，整数。
我已经提供了一个数据的样子，下面是我的代码。 如果有一个更好的方法来处理这个问题，那么我可以接受其他解决scheme。
下面的代码确实在AggregateSeptember（）中返回一个错误，返回错误的那一行有解释它的注释。 谢谢你的感觉。
执行后第8页L5应=“1,9,29,37,50,61”
我完全被这个难住，并没有写任何VB之前，我将不胜感激任何帮助。
提前感谢您的时间和考虑，蒂姆
下面的数据是在VBA运行之前。 代码运行Sheet8.L5.value =“1,9,29,37,50,61”如上所述）。
数据
Sheet 5 M5 N5 O5 P5 Q5 R5 37 0 0 0 0 0 Sheet 6 M5 N5 O5 P5 Q5 R5 1 9 0 0 0 0 Sheet 7 M5 N5 O5 P5 Q5 R5 29 50 61 0 0 0 Sheet 8 L5 0 数据
Sub AggregateSeptember() Dim i As Integer Dim j As Integer Dim SeptemberTerm1Aggregate As String Dim SeptemberTerm1(0 To 14) As Integer Dim SeptemberTerm2() As Integer Dim SeptemberCols SeptemberCols = Array("M5", "N5", "O5", "P5", "Q5") For i = 0 To 14 If i < 5 Then If Sheet5.Range(SeptemberCols(i)) <> 0 Then SeptemberTerm1(i) = Sheet5.Range(SeptemberCols(i)) End If ElseIf i < 10 Then If Sheet6.Range(SeptemberCols(i - 5)) <> 0 Then SeptemberTerm1(i - 5) = Sheet6.Range(SeptemberCols(i - 5)) End If ElseIf i < 15 Then If Sheet7.Range(SeptemberCols(i - 10)) <> 0 Then SeptemberTerm1(i - 10) = Sheet7.Range(SeptemberCols(i - 10)) End If End If Next i ' This next line no longer returns an error SeptemberTerm2 = BubbleSrt(SeptemberTerm1, True) For j = 0 To 14 If SeptemberTerm2(j) > 0 Then SeptemberTerm1Aggregate = SeptemberTerm1Aggregate & SeptemberTerm2(j) If j > 0 And j < 14 And SeptemberTerm2(j) > 0 Then SeptemberTerm1Aggregate = SeptemberTerm1Aggregate & ", " Next j Sheet8.Range("L5").Value = SeptemberTerm1Aggregate End Sub Public Function BubbleSrt(ArrayIn, Ascending As Boolean) Dim SrtTemp As Variant Dim i As Long Dim j As Long If Ascending = True Then For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) > ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i Else For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) < ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i End If BubbleSrt = ArrayIn End Function
那么，看起来你比我快，但这是我的解决scheme。 只需将"Sheet1" ，…， "Sheet4"更改为任何您需要的内容即可。
Sub AggregateSeptember() Dim i As Integer ' Counter for Sheets Dim j As Integer ' Counter for Columns Dim k As Integer ' Counter for your data Dim vMySheets As Variant ' Sheets Dim vSeptemberCols As Variant ' Columns Dim iCurrent As Integer ' Current data Dim iSeptemberTerm() As Integer ' Data array Dim sAggregate As String ' Aggregate string vMySheets = Array("Sheet1", "Sheet2", "Sheet3") vSeptemberCols = Array("M5", "N5", "O5", "P5", "Q5", "R5") ReDim iSeptemberTerm(0 To (UBound(vMySheets) + 1) * (UBound(vSeptemberCols) + 1) - 1) k = 0 For i = LBound(vMySheets) To UBound(vMySheets) For j = LBound(vSeptemberCols) To UBound(vSeptemberCols) iCurrent = ThisWorkbook.Sheets(vMySheets(i)).Range(vSeptemberCols(j)).Value If iCurrent <> 0 Then iSeptemberTerm(k) = iCurrent k = k + 1 End If Next j Next i ReDim Preserve iSeptemberTerm(0 To k - 1) ' This is just to eliminate the unused elements iSeptemberTerm = BubbleSrt(iSeptemberTerm, True) For i = LBound(iSeptemberTerm) To UBound(iSeptemberTerm) sAggregate = sAggregate & iSeptemberTerm(i) & ", " Next i sAggregate = Left(sAggregate, Len(sAggregate) - Len(", ")) ThisWorkbook.Sheets("Sheet4").Range("L5").Value = sAggregate End Sub
一些注意事项：
- 不要害怕投掷新的柜台，如果需要:)
- 你在
SeptemberCols忘了放"R5"了 - 您可以在其他循环中重复使用相同的计数器（您可以在第二个循环中使用
i） - 请注意，我能够使
iSeptemberTerm = BubbleSrt(iSeptemberTerm, True)因为我如何声明它（没有固定的边界，以便可以对其进行修改）
我已经解决了。 虽然如果有人有任何想法的方式来做这个循环多行或更有效的方式来完成这将是伟大的。
我已经在下面发布了正确的代码。 我留下了两条违规的线路，但是有人想看看，就留下了评论。 我愚蠢的错误。
感谢任何花时间在此的人，特别感觉到这一点。
Sub AggregateSeptember() Dim i As Integer Dim j As Integer Dim SeptemberTerm1Aggregate As String Dim SeptemberTerm1(0 To 14) As Integer Dim SeptemberTerm2() As Integer Dim SeptemberCols SeptemberCols = Array("M5", "N5", "O5", "P5", "Q5") For i = 0 To 14 If i < 5 Then If Sheet5.Range(SeptemberCols(i)) <> 0 Then SeptemberTerm1(i) = Sheet5.Range(SeptemberCols(i)) End If ElseIf i < 10 Then If Sheet6.Range(SeptemberCols(i - 5)) <> 0 Then 'SeptemberTerm1(i - 5) = Sheet6.Range(SeptemberCols(i - 5)) SeptemberTerm1(i) = Sheet6.Range(SeptemberCols(i - 5)) End If ElseIf i < 15 Then If Sheet7.Range(SeptemberCols(i - 10)) <> 0 Then 'SeptemberTerm1(i - 10) = Sheet7.Range(SeptemberCols(i - 10)) SeptemberTerm1(i) = Sheet7.Range(SeptemberCols(i - 10)) End If End If Next i ' This next line no longer returns an error SeptemberTerm2 = BubbleSrt(SeptemberTerm1, True) For j = 0 To 14 If SeptemberTerm2(j) > 0 Then SeptemberTerm1Aggregate = SeptemberTerm1Aggregate & SeptemberTerm2(j) If j > 0 And j < 14 And SeptemberTerm2(j) > 0 Then SeptemberTerm1Aggregate = SeptemberTerm1Aggregate & ", " Next j Sheet8.Range("L5").Value = SeptemberTerm1Aggregate End Sub Public Function BubbleSrt(ArrayIn, Ascending As Boolean) Dim SrtTemp As Variant Dim i As Long Dim j As Long If Ascending = True Then For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) > ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i Else For i = LBound(ArrayIn) To UBound(ArrayIn) For j = i + 1 To UBound(ArrayIn) If ArrayIn(i) < ArrayIn(j) Then SrtTemp = ArrayIn(j) ArrayIn(j) = ArrayIn(i) ArrayIn(i) = SrtTemp End If Next j Next i End If BubbleSrt = ArrayIn End Function