恳请大神帮忙看下这个分类的难题

qiongmei6

我想在附件上求得一个代码，当他执行的时候，根据y：aa列中，按改制职工、合同工、聘用工分类，对应的分类到ag：ai，aj：al，am：ao列，目前的ag：ai，aj：al，am：ao就是我希望代码执行后最后的结果。

taller

qiongmei6

谢谢taller大神的回答，我对着代码一个字一个字敲，不知道是哪个步骤没敲对，目前代码不工作，能否麻烦您再看下，再次谢谢您的帮忙

ykcbf1100

参与一下。。。

ykcbf1100

附件供参考。。。

taller

1. Sub Demo()
   
2.     Dim i As Long, j As Long
   
3.     Dim arrData, rngData As Range
   
4.     Dim arrRes
   
5.     Dim iR(3) As Long
   
6.     Dim LastRow As Long, arr1, arr2, arr3
   
7.     LastRow = Cells(Rows.Count, "y").End(xlUp).Row
   
8.     If LastRow > 3 Then
   
9.         ReDim arr1(1 To LastRow - 2, 1 To 3)
   
10.         ReDim arr2(1 To LastRow - 2, 1 To 3)
    
11.         ReDim arr3(1 To LastRow - 2, 1 To 3)
    
12.         Set rngData = Range("Y2:aa" & LastRow)
    
13.         arrData = rngData.Value
    
14.         For i = LBound(arrData) To UBound(arrData)
    
15.             Select Case arrData(i, 1)
    
16.             Case Is = "¸ÄÖÆÖ°¹¤"
    
17.                 iR(1) = iR(1) + 1
    
18.                 For j = 1 To 3
    
19.                     arr1(iR(1), j) = arrData(i, j)
    
20.                 Next
    
21.             Case Is = "ºÏͬ¹¤"
    
22.                 iR(2) = iR(2) + 1
    
23.                 For j = 1 To 3
    
24.                     arr2(iR(2), j) = arrData(i, j)
    
25.                 Next
    
26.             Case Is = "ƸÓù¤"
    
27.                 iR(3) = iR(3) + 1
    
28.                 For j = 1 To 3
    
29.                     arr3(iR(3), j) = arrData(i, j)
    
30.                 Next
    
31.             End Select
    
32.         Next i
    
33.     End If
    
34.     Range("AG3:Ao" & Rows.Count).ClearContents
    
35.     If iR(1) > 0 Then _
    
36.     Range("AG3").Resize(iR(1), 3).Value = arr1
    
37.     If iR(2) > 0 Then _
    
38.     Range("aj3").Resize(iR(2), 3).Value = arr2
    
39.     If iR(3) > 0 Then _
    
40.     Range("am3").Resize(iR(3), 3).Value = arr3
    
41. End Sub

复制代码

taller

lhj5286

参与一下，看能否满足楼主需求