PDA

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

mana
11-06-2017, 08:00 AM
What’s the problem?

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: