View Full Version : [SOLVED:] Data grouping?
idnoidno
11-06-2017, 07:36 AM
I want to filter the data, and then write the results of the grouping to the worksheet, can someone help me to adjust the code?for example, "for j=1 to ubound(ar,2)",
"worksheets(2)、worksheets(3)、worksheets(4). I am very grateful for any help.
20870
Paul_Hossler
11-06-2017, 08:17 AM
I think you're over complicating the macro
Unless you really want to use arrays, something simple might work just as well
Option Explicit
Sub t1()
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
Dim r1 As Range
i2 = 1
i3 = 1
i4 = 1
Set r1 = Worksheets(1).Cells(1, 1).CurrentRegion
Application.ScreenUpdating = False
Worksheets(2).Cells(1, 1).CurrentRegion.Clear
Worksheets(3).Cells(1, 1).CurrentRegion.Clear
Worksheets(4).Cells(1, 1).CurrentRegion.Clear
For i1 = 1 To r1.Rows.Count
Select Case r1.Cells(i1, 2)
Case Is < 5
r1.Rows(i1).Copy Worksheets(2).Cells(i2, 1)
i2 = i2 + 1
Case Is < 10
r1.Rows(i1).Copy Worksheets(3).Cells(i3, 1)
i3 = i3 + 1
Case Else
r1.Rows(i1).Copy Worksheets(4).Cells(i4, 1)
i4 = i4 + 1
End Select
Next i1
Application.ScreenUpdating = True
End Sub
or
Sub t2()
Dim i1 As Long, ix As Long
Dim r1 As Range, rx As Range
Set r1 = Worksheets(1).Cells(1, 1).CurrentRegion
Application.ScreenUpdating = False
Worksheets(2).Cells(1, 1).CurrentRegion.Clear
Worksheets(3).Cells(1, 1).CurrentRegion.Clear
Worksheets(4).Cells(1, 1).CurrentRegion.Clear
For i1 = 1 To Worksheets(1).Cells(1, 1).CurrentRegion.Rows.Count
Select Case r1.Cells(i1, 2)
Case Is < 5
ix = 2
Case Is < 10
ix = 3
Case Else
ix = 4
End Select
Set rx = Worksheets(ix).Cells(Worksheets(ix).Rows.Count, 1).End(xlUp)
If Len(rx.Value) = 0 Then
r1.Rows(i1).Copy rx
Else
r1.Rows(i1).Copy rx.Offset(1, 0)
End If
Next i1
Application.ScreenUpdating = True
End Sub
idnoidno
11-06-2017, 08:27 AM
Sub t1()
Dim ar, br, cr, dr, er
Dim i%, j%, n%, m%, k%
ar = [a1].CurrentRegion
ReDim br(1 To UBound(ar, 1), 1 To UBound(ar, 2))
ReDim cr(1 To UBound(ar, 1), 1 To UBound(ar, 2))
ReDim dr(1 To UBound(ar, 1), 1 To UBound(ar, 2))
er = Array(br, ccr, dr)
n = 1
m = 1
k = 1
For i = 1 To UBound(ar, 1)
Select Case ar(i, 2)
Case Is < 5
For j = 1 To UBound(ar, 2)
br(n, j) = ar(i, j)
Next j
n = n + 1
Case Is < 10
For j = 1 To UBound(ar, 2)
cr(m, j) = ar(i, j)
Next j
m = m + 1
Case Else
For j = 1 To UBound(ar, 2)
dr(k, j) = ar(i, j)
Next j
k = k + 1
End Select
Next i
er = Array(br, cr, dr)
For i = 0 To UBound(er)
With Worksheets(i + 2)
.Cells(1, 1).Resize(UBound(ar, 1), UBound(ar, 2)) = er(i)
End With
Next i
End Sub
Thanks for your answer.
The above is what I just thought.
MagPower
01-09-2019, 07:04 PM
Just as an FYI, at the top of your Sub, you have "er = Array(br, CCR, dr)", when it should be "er = Array(br, CR, dr)" .
Paul_Hossler
01-09-2019, 07:18 PM
Just as an FYI, at the top of your Sub, you have "er = Array(br, CCR, dr)", when it should be "er = Array(br, CR, dr)" .
1. That's the reason to use Option Explicit
2. This is an old post and while your comment is certainly valid, most likely the OP doesn't need it any more
3. Welcome to the forum :yes - Glad to have you on board
4. Take a minute to read the tips and FAQ links in my sig
MagPower
01-10-2019, 03:09 AM
Thanks Paul :hi:
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.