区域排序取数值的问题，谢谢！

jinball

意甲-ao.rar (21.65 KB, 下载次数: 11)

2014-1-2 14:32 上传

点击文件名下载附件

打击好，说明都在附件中了，在Sheet1中A1:L10区域中按照I列数据从小到大进行排序，取L列中的数值填充到Sheet2当中去，注意Sheet2中有范例，谢谢大家，帮个忙！！！祝福大家2014马上有钱！

zhaogang1960

请测试：

1. Sub 宏1()
   
2.     Dim cnn As Object, rs As Object, SQL$, arr(1 To 1000, -1 To 9), i&, j&, m&
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;Extended Properties ='Excel 12.0 Macro;hdr=no';Data Source=" & ThisWorkbook.FullName
   
5.     For i = 1 To Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row Step 10
   
6.         m = m + 1
   
7.         SQL = "select f4 from [Sheet1$I" & i & ":L" & i + 9 & "] order by f1"
   
8.         Set rs = CreateObject("ADODB.recordset")
   
9.         rs.Open SQL, cnn, 1, 3
   
10.         arr(m, -1) = "I" & i & ":L" & i + 9
    
11.         For j = 0 To 9
    
12.             arr(m, j) = rs.Fields(0).Value
    
13.             rs.MoveNext
    
14.         Next
    
15.     Next
    
16.     With Sheets("Sheet2")
    
17.         .Cells.ClearContents
    
18.         .[a1].Resize(m, 11) = arr
    
19.     End With
    
20.     rs.Close
    
21.     cnn.Close
    
22.     Set rs = Nothing
    
23.     Set cnn = Nothing
    
24. End Sub
    

复制代码

zhaogang1960

请看附件
意甲-ao.rar (35.86 KB, 下载次数: 14)

2014-1-2 15:13 上传

点击文件名下载附件

jinball

zhaogang1960 发表于 2014-1-2 15:13
请看附件

老天呀，真是高手啊，太棒了，zhaogang1960版主我祝你2014那啥，想啥马上有啥！
不过还有点问题，那个按钮位置能不能改变一下，挡住数据了。
还有我还想按照J列在Sheet3里面排列一遍，应该如何操作，看来复制是不行，我对VBA不懂啊，谢谢！

jinball

zhaogang1960 发表于 2014-1-2 15:13
请看附件

版主搞定了，我会修改那个按钮的位置了，也会插入代码了，谢谢了，我自己先琢磨一下，肯定还会有问题，到时候希望您能帮忙！再次感谢！

zhaogang1960

jinball 发表于 2014-1-2 15:28
老天呀，真是高手啊，太棒了，zhaogang1960版主我祝你2014那啥，想啥马上有啥！
不过还有点问题，那个按 ...

右键单击按钮，可以随便移动它，或删除它
Sheet3是空的，怎么排列，请模拟效果传上来我看看

jinball

zhaogang1960 发表于 2014-1-2 15:39
右键单击按钮，可以随便移动它，或删除它
Sheet3是空的，怎么排列，请模拟效果传上来我看看

Sheet3先不用麻烦您，我自己尝试先做一遍试试，另外我还想带上条件格式，如果我自己搞不定再麻烦您，呵呵

zhaogang1960

jinball 发表于 2014-1-2 15:56
Sheet3先不用麻烦您，我自己尝试先做一遍试试，另外我还想带上条件格式，如果我自己搞不定再麻烦您，呵呵

条件格式在哪里？

ADO仅复制数据，如果要复制格式，需要使用Excel工作表排序

jinball

zhaogang1960 发表于 2014-1-2 16:02
条件格式在哪里？

ADO仅复制数据，如果要复制格式，需要使用Excel工作表排序

意甲-威廉.rar (33.25 KB, 下载次数: 3)

2014-1-2 16:34 上传

点击文件名下载附件

就是这个里面的Sheet3中的效果，再麻烦您了！

zhaogang1960

jinball 发表于 2014-1-2 16:35
就是这个里面的Sheet3中的效果，再麻烦您了！

1. Sub Macro1()
   
2.     Dim arr, brr(1 To 1000, 0 To 10), i&, j&, m&, sh As Worksheet
   
3.     Set sh = Sheets("Sheet3")
   
4.     sh.Cells.Clear
   
5.     With Sheets("Sheet1")
   
6.         For i = 1 To Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row Step 10
   
7.             m = m + 1
   
8.             .Cells(i, 1).Resize(10, 13).Sort Key1:=.Cells(i, 9), Order1:=1, Header:=xlNo
   
9.             arr = .Cells(i, 12).Resize(10)
   
10.             brr(m, 0) = "I" & i & ":L" & i + 9
    
11.             For j = 1 To 10
    
12.                 brr(m, j) = arr(j, 1)
    
13.                 .Cells(i + j - 1, 12).Copy
    
14.                 sh.Cells(m, j + 1).PasteSpecial Paste:=xlPasteFormats
    
15.             Next
    
16.         Next
    
17.     End With
    
18.     sh.[a1].Resize(m, 11) = brr
    
19. End Sub
    

复制代码